home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / misc / emu / Apex-src.lha / ASM.XPL < prev    next >
Text File  |  2001-09-30  |  55KB  |  2,471 lines
  1. \ASM.XPL    APR-10-87    VERSION 1.0x10
  2. \68000 ASSEMBLER
  3. \Written by Loren Blaney for DFM Engineering
  4.  
  5. \REVISION HISTORY:
  6. \APR-18-86, Original
  7. \APR-30-86, Cross-reference
  8. \MAY-03-86, INCLUDE pseudo op
  9. \AUG-21-86, Fixed miscellaneous bugs
  10. \SEP-08-86, Fixed LINK & STOP size bug
  11. \OCT-19-86, Fixed sync problem with Bcc instrucitons, and modified for
  12. \ new compiler.
  13. \APR-10-87, Changed string conventions and fixed EXG An,An bug.
  14.  
  15. \WARNINGS:
  16. \This assembler uses 32-bit constants and is intended to be compiled
  17. \ using 32-bit XPL. However, it will work using 16-bit XPL if the program
  18. \ you're assembling does not use any values outside the range +/-32K.
  19. \ Set INTSIZE appropriately.
  20. \
  21. \This will not run on the 6502 without some modification of Apex-dependent
  22. \ stuff. The INCLUDE pseudo-op requires this program to do its own input
  23. \ buffering.
  24. \
  25. \NOTES:
  26. \Beyond the mnemonic field, spaces are stripped out and have no meaning.
  27. \It is assumed that a 96-column printer is used.
  28.  
  29. code    ABS=0,        REM=2,        RESERVE=3,    SWAP=4,
  30.     CHIN=7,        CHOUT=8,    CRLF=9,        INTIN=10,
  31.     INTOUT=11,    TEXT=12,    OPENI=13,    OPENO=14,
  32.     CLOSE=15,    HEXOUT=27,    SCAN=24,    READ=31;
  33.  
  34. int    CHAR,        \Current character from GETCH
  35.     LINEINX,    \Index into LINEBUF
  36.     LINECTR,    \Count the the lines from start of (INCLUDE) file
  37.     HASH,        \Current identifier hash code
  38.  
  39.     OPCODE,        \Code for first word of instruction
  40.     OPSIZE,        \Instruction size in words
  41.     MNTYPE,        \Mnemonic type (several opcodes belong to one type)
  42.  
  43.     EA,        \Effective address bit field (mode, register)
  44.     EXTLEN,        \Number of extension words beyond opcode
  45.     EXTWD,        \Array: instruction extension words
  46.     GENINX,        \Index into GENBUF
  47.     MODEFLAG,    \Bit array: indicates address mode
  48.             \Bit assignments:
  49.             \F: --        E: CCR        D: SR        C: USP
  50.             \B: Imm        A: d(PC,Xn)    9: d(PC)    8: Abs.L
  51.             \7: Abs.W    6: d(An,Xn)    5: d(An)    4: -(An)
  52.             \3: (An)+    2: (An)        1: An        0: Dn
  53.  
  54.     PASS,        \Assembly pass counter (1 or 2)
  55.             \(3 is a kludge to report some errors on pass 1)
  56.     ERRCNT,        \Error counter
  57.     ERRTOLD,    \Flag: used to report only one error per line
  58.  
  59.     DEFAULT,    \Array: default devices, etc.
  60.     LISTDEV,    \Listing output device number
  61.     OBJDEV,        \Object output device number (.OBJ file)
  62.  
  63.     LISTON,        \Flag: do listing
  64.     ASMON,        \Flag: do assemble (for IF pseudo-op)
  65.     XREFON,        \Flag: do cross reference
  66.     ENDFOUND,    \Flag: END pseudo-op or EOF found
  67.  
  68.     PC,        \Program counter
  69.     LABEL,        \Value of label field (usually = PC, = EXPR for EQU)
  70.     LABINX,        \Symbol table index for label on current line
  71.     SYMNUM,        \Index for next symbol in the symbol table
  72.     XREFNUM,    \Index for next reference in cross-reference table
  73.  
  74.     SYMVAL,        \Array: symbol's value (PC, OPCODE, MODE)
  75.     SYMNEXT,    \Array: linkage index to next entry with same hash code
  76.     HASHTBL,    \Hash table: contains indexes into symbol table arrays
  77.  
  78.     SYMINX,        \Array: indicies sorted by symbol name
  79.     SYMXREF,    \Array: indicies to cross-reference list
  80.     XREFPC,        \Array: cross-reference table PC values
  81.     XREFNEXT,    \Array: cross-reference table linkage index
  82.  
  83.     INUNIT,        \Unit that input file is on
  84.     FBLK,        \First block of current input buffer-full
  85.     LBLK,        \Last block of input file
  86.     INCLLEV,    \Nesting level of current include file (0-7)
  87.     INBUFINX,    \Index into INBUF
  88.     INCLNEST,    \Array(8,5): parameters for each level of include nesting
  89.     INBUFSIZE,    \Number of bytes in INBUF
  90.     II,        \Scratch for MAIN
  91.     ;
  92.  
  93. addr    SYMTBL,        \Array: symbol table identifier names (IDENT)
  94.     SYMCLASS,    \Array: symbol class (label, mnemonic, or reserved)
  95.     SYMTYPE,    \Array: symbol's type value --
  96.             \ for labels: normally = $00, changeable (EQU) = $01
  97.             \ for mnemonics: instruction type: NOP, JMP, ETC.
  98.             \ for reserved names: EA bits
  99.     LINEBUF,    \Array: source code line buffer
  100.     IDENT,        \Array: current identifier (symbol) name
  101.     GENBUF,        \Array: holds object code (for listing)
  102.  
  103.     INBUF,        \Array: input buffer (same as Apex's)
  104.     ADDR,        \Used to access bytes at absolute addresses
  105.     ;
  106.  
  107. def    TV=0, KB=0, NULLDEV=7;            \I/O devices
  108. def    NUL=$00, BEL=$07, TAB=$09, SP=$20,    \ASCII characters
  109.     CR=$0D, LF=$0A, FF=$0C,
  110.     EOF=$1A,
  111.     ;
  112.  
  113. def    INTSIZE=4,    \number of bytes in an integer (2 or 4)
  114.     SYMSIZE=1000,    \size of the symbol table (entries)    *** DEBUG ***
  115.     XREFSIZE=5000,    \size of cross-reference table (entries)
  116.     SIGCHAR=8,    \no. of significant chars in IDENT
  117.             \SIGCHARS must be >= 8 because of INCLUDE
  118.     LINESIZE=256,    \maximum number of characters allowed on a line
  119.     GENSIZE=6,    \number of bytes of object code shown on listing
  120.     ;
  121. def    \SYMCLASS\ LAB, MN, RES;    \symbol class: label, mnemonic, reserved
  122.  
  123. def    \MNTYPE\ NOP, JMP, MOVE, MOVEA, MOVEP, MOVEM, CLR, EXT, SWP, ADDI,
  124.     NBCD, EOR, EXG, LEA, LINK, STOP, TRAP, UNLK, ADD, CMP, CMPM, ADDA,
  125.     AND, ANDI, CHK, BCHG, ASL, BCC, ADDQ, MOVEQ, ABCD, ADDX, DBCC, SCC,
  126.     ORG, EQU, NOLIST, LIST, PAGE, DC, DS, DCB, ASCII, IF, ELSE, ENDIF,
  127.     INCLUDE, END;
  128. \WARNING: ASMLINE assumes that NOP & SCC are respectively the first and
  129. \ last non-pseudo instructions.
  130.  
  131. def    \OPSIZE\    NOSIZE=0, BYTE=1, WORD=2, LONG=3, SHORT=4, BADSIZE=5;
  132. def    DEFOPSIZE=WORD;    \DEFAULT OPCODE SIZE
  133. \(BADSIZE means that size must be specified. I.e. don't allow ambiguous size)
  134.  
  135. \Apex system page parameters:
  136. def    INLBLK=$562, INHBLK=$566, INUNT=$56C, INBUFD=$48E, INBUFE=$492;
  137.  
  138. \========================= OUTPUT ROUTINES ============================
  139.  
  140. proc    HEX_B(DEV, I);    \Output ASCII hex byte to device
  141. int    DEV, I;
  142. addr    HEXDIGIT;     \Array: ASCII hex DIGITS (0 - F)
  143. begin
  144. HEXDIGIT:= "0123456789ABCDEF";
  145. CHOUT(DEV, HEXDIGIT(I>>4 & $0F));
  146. CHOUT(DEV, HEXDIGIT(I & $0F));
  147. end;    \HEX_B
  148.  
  149.  
  150.  
  151. proc    DOSYNC;        \Generate a sync byte if necessary
  152. begin
  153. if PC & 1 then
  154.     begin
  155.     if PASS = 2 then HEX_B(OBJDEV,0);  \output a sync byte
  156.     PC:= PC +1;
  157.     LABEL:= PC;    \If there is a label then fix it
  158.     if LABINX # -1 then
  159.         begin
  160.         SYMVAL(LABINX):= LABEL;
  161.         SYMTYPE(LABINX):=$01;    \Indicate changeable label (phase)
  162.         end;
  163.     end;
  164. end;    \DOSYNC
  165.  
  166.  
  167.  
  168. proc    HEX0OUT(DEV,N);    \Output ASCII hex integer
  169. \This is similar to HEXOUT, but leading zeros are suppressed and the number
  170. \ is right justified.
  171. int    DEV, N;
  172. int    FLAG, I, DIGIT;
  173. addr    HEXDIGIT, A;
  174. begin
  175. HEXDIGIT:= "0123456789ABCDEF";
  176. A:=addr N;
  177. FLAG:= 0;                \Flag used to suppress leading zeros
  178. for I:= 0,INTSIZE-1 do
  179.     begin
  180.     DIGIT:= A(I) >>4;        \Output high nybble
  181.     FLAG:= FLAG ! DIGIT;
  182.     CHOUT(DEV,if FLAG then HEXDIGIT(DIGIT) else SP);
  183.  
  184.     DIGIT:= A(I)&$0F;        \Output low nybble
  185.     FLAG:= FLAG ! DIGIT ! I=INTSIZE-1;
  186.     CHOUT(DEV,if FLAG then HEXDIGIT(DIGIT) else SP);
  187.     end;
  188. end;    \HEX0OUT
  189.  
  190.  
  191.  
  192. proc    GEN_B(OP);    \Generate a byte of object code
  193. int    OP;
  194. begin
  195. if PASS = 2 then
  196.     begin
  197.     HEX_B(OBJDEV, OP);
  198.     if GENINX<GENSIZE then
  199.         [GENBUF(GENINX):= OP; GENINX:= GENINX +1];
  200.     end;
  201. PC:= PC +1;
  202. end;    \GEN_B
  203.  
  204.  
  205.  
  206. proc    GEN_W(OP);    \Generate a word of object code
  207. int    OP;
  208. begin
  209. GEN_B(SWAP(OP)); GEN_B(OP);
  210. end;    \GEN_W
  211.  
  212.  
  213.  
  214. proc    GENINSTR;    \Generate object code for the current instruction
  215. \Inputs: OPCODE, EXTLEN, EXTWD
  216. int    I;
  217. begin
  218. GEN_W(OPCODE);
  219. for I:=1,EXTLEN do
  220.     begin
  221.     GEN_W(EXTWD(I-1));
  222.     end;
  223. end;    \GENINSTR
  224.  
  225.  
  226.  
  227. proc    LINEOUT(DEV);    \Output the line buffer to specified device
  228. int    DEV;
  229. int    I;
  230. begin
  231. for I:=0,LINESIZE-1 do
  232.     begin
  233.     CHOUT(DEV,LINEBUF(I));
  234.     if LINEBUF(I)=CR then I:=LINESIZE;    \Exit 'FOR' loop
  235.     end;
  236. end;    \LINEOUT
  237.  
  238.  
  239.  
  240. proc    LISTOUT(DEV);    \List object code and LINEBUF on specified device
  241. \Other inputs: MNTYPE, LABEL, GENBUF, GENINX
  242. \012345678901234567890123
  243. \01234567: 1234 12341234 LABEL   MOVE.L
  244. int    DEV;
  245. int    I, FLAG;
  246. begin
  247. FLAG:= ASMON;                \Should the label value be displayed?
  248. case MNTYPE of
  249.   -1, NOLIST, LIST, PAGE, ELSE, ENDIF, ENDIF, INCLUDE, END:
  250.     if LABINX = -1 then FLAG:= false
  251. other;
  252.  
  253. if FLAG then
  254.     begin
  255.     HEX0OUT(DEV,LABEL);
  256.  
  257.     CHOUT(DEV,if GENINX>0 then ^: else SP);
  258.     CHOUT(DEV,SP);
  259.     for I:=0,GENSIZE-1 do
  260.         begin
  261.         if I=2 then CHOUT(DEV,SP);
  262.         if I<GENINX then HEX_B(DEV,GENBUF(I))
  263.         else TEXT(DEV,"  ");
  264.         end;
  265.     TEXT(DEV,"    ");
  266.     end
  267. else    TEXT(DEV,"            ");
  268.  
  269. LINEOUT(DEV);
  270. end;    \LISTOUT
  271.  
  272. \----------------------------------------------------------------------
  273.  
  274. proc    QUICKSORT;    \Quicksort SYMTBL into alphabetical order
  275. \??? MULTIPLE LABELS ???
  276. \Inputs: SYMTBL, SYMINX
  277. \This routine is subtle and treacherous. You better understand it well
  278. \ before dinging with it, or it will surly bomb.
  279. int    TEMP, PVTLINE;
  280. int    X, Y;
  281. def    SYMONE=0\$9E\;    \Index of the first symbol beyond mnemonics, etc.
  282.  
  283.  
  284.  
  285. proc    SORT(L, R);
  286. int    L, R;        \Left and right limits to SYMINX array
  287. int    I, J;        \Indicies
  288. begin
  289. loop    begin
  290.     I:= L; J:= R;
  291.     PVTLINE:= SYMINX((L+R) >>1);
  292.     repeat    begin
  293.         loop    begin
  294.             X:= SYMINX(I); Y:= PVTLINE;
  295.             if X = Y then quit;
  296.             while SYMTBL(X) = SYMTBL(Y) do
  297.                 [X:= X +SYMSIZE; Y:= Y +SYMSIZE];
  298.             if SYMTBL(X) > SYMTBL(Y) then quit;
  299.             I:= I +1;
  300.             end;
  301.  
  302.         loop    begin
  303.             X:= PVTLINE; Y:= SYMINX(J);
  304.             if X = Y then quit;
  305.             while SYMTBL(X) = SYMTBL(Y) do
  306.                 [X:= X +SYMSIZE; Y:= Y +SYMSIZE];
  307.             if SYMTBL(X) > SYMTBL(Y) then quit;
  308.             J:= J -1;
  309.             end;
  310.  
  311.         if I <= J then
  312.             begin        \Swap elements
  313.             TEMP:= SYMINX(I);
  314.             SYMINX(I):= SYMINX(J);
  315.             SYMINX(J):= TEMP;
  316.             I:= I +1;
  317.             J:= J -1;
  318.             end;
  319.         end;
  320.     until I > J;
  321.  
  322.     if J-L < R-I then
  323.         begin
  324.         if L < J then SORT(L, J);
  325.         if I < R then L:= I else quit;    \SORT(I, R)
  326.         end
  327.     else    begin
  328.         if I < R then SORT(I, R);
  329.         if L < J then R:= J else quit;    \SORT(L, J)
  330.         end;
  331.     end;
  332. end;    \SORT
  333.  
  334.  
  335.  
  336. begin    \QUICKSORT
  337. if SYMNUM > SYMONE then SORT(SYMONE, SYMNUM-1);
  338. end;    \QUICKSORT
  339.  
  340. \----------------------------------------------------------------------
  341.  
  342. proc    XREFOUT;    \Output the cross-reference listing
  343. \Inputs: SYMNUM, SYMCLASS, SYMTBL, SYMXREF, XREFNEXT, XREFPC.
  344. int    S,        \Symbol
  345.     INX,        \Index into symbol table
  346.     XINX,        \Index into cross-reference table
  347.     FLAG,        \Flag: indicates reference to a label
  348.     I, IINX,    \Scratch
  349.     REF,        \References-per-line counter
  350.     SPTR,        \Stack pointer (index)
  351.     STACK;        \Stack for reversing reference order
  352. def    MAXREF= 9,    \Maximum number of references on a line (= 96 /9 -1)
  353.     STKSIZE= 1000;    \Stack size (entries)
  354. begin
  355. STACK:= RESERVE(STKSIZE *INTSIZE);
  356. CRLF(LISTDEV);
  357. for I:=0,SYMNUM-1 do SYMINX(I):=I;
  358. QUICKSORT;                \Alphabetize the symbol names
  359.  
  360. for S:=0,SYMNUM-1 do        \For all of the labels in the symbol table
  361.     begin
  362.     INX:= SYMINX(S);        \Get the sorted index
  363.     if SYMCLASS(INX) = LAB then
  364.         begin
  365.         IINX:= INX;        \List the symbol's name
  366.         for I:= 0,SIGCHAR-1 do
  367.             begin
  368.             CHOUT(LISTDEV,SYMTBL(IINX));
  369.             IINX:= IINX +SYMSIZE;
  370.             end;
  371.         CHOUT(LISTDEV,SP);
  372.  
  373.         \Reverse the order of the references:
  374.         SPTR:= STKSIZE;
  375.         XINX:= SYMXREF(INX);    \Get the index into the XREF table
  376.         loop    begin
  377.             SPTR:= SPTR -1;    \Push it onto the stack
  378.             if SPTR<0 then
  379.                 begin
  380.                 TEXT(TV,"*** XREF OVERFLOW ***");
  381.                 CHOUT(TV,BEL);
  382.                 return;
  383.                 end;
  384.             STACK(SPTR):= XINX;
  385.  
  386.             if XINX<0 then XINX:= -XINX;
  387.             XINX:= XREFNEXT(XINX);
  388.             if XINX= 0 then quit;
  389.             end;
  390.  
  391.         REF:= 0;            \List the references
  392.         loop    begin
  393.             XINX:= STACK(SPTR);
  394.             SPTR:= SPTR +1;        \Pull index from stack
  395.  
  396.             FLAG:= XINX < 0;    \Set flag if it is a label
  397.             if FLAG then XINX:= -XINX;
  398.  
  399.             if REF >= MAXREF then
  400.                 begin        \New line -- indented
  401.                 CRLF(LISTDEV);
  402.                 for I:= 0,SIGCHAR do CHOUT(LISTDEV,SP);
  403.                 REF:= 0;
  404.                 end;
  405.             HEX0OUT(LISTDEV,XREFPC(XINX));
  406.             CHOUT(LISTDEV,if FLAG then ^. else SP);
  407.             REF:= REF +1;
  408.             if SPTR >= STKSIZE then quit;
  409.             end;
  410.         CRLF(LISTDEV);
  411.         end;
  412.     end;
  413. end;    \XREFOUT
  414.  
  415. \====================== MISCELLANEOUS ROUTINES ========================
  416.  
  417. func    PEEKI(ADDR);    \Returns the integer at the given address
  418. int    ADDR;
  419. return ADDR(0);
  420.  
  421.  
  422.  
  423. proc    ERROR(STR);    \Output error message to TV and LISTDEV
  424. int    STR;
  425. begin
  426. if PASS = 1 then return;        \Don't report any errors on pass 1
  427. \("Undefineds" may be forward references; also, forward referenced values
  428. \ may be out of range)
  429. if ERRTOLD then return;            \Only report one error per line
  430.  
  431. TEXT(TV,"***** ERROR ON LINE "); INTOUT(TV,LINECTR); TEXT(TV," - ");
  432. TEXT(TV,STR);
  433. CRLF(TV);
  434. if LISTDEV#TV ! not LISTON ! PASS=3 then LISTOUT(TV);    \Make sure line is shown
  435.  
  436. if LISTDEV#TV then            \(Don't display it a second time)
  437.     begin
  438.     TEXT(LISTDEV,"***** ERROR ON LINE "); INTOUT(LISTDEV,LINECTR);
  439.     TEXT(LISTDEV," - ");
  440.     TEXT(LISTDEV,STR);
  441.     CRLF(LISTDEV);
  442.     if not LISTON ! PASS = 3 then LISTOUT(LISTDEV);    \Make sure line is shown
  443.     end;
  444.  
  445. ERRCNT:= ERRCNT+1;
  446. ERRTOLD:= true;
  447. end;    \ERROR
  448.  
  449. \----------------------------------------------------------------------
  450.  
  451. func    SWAPWD(I);    \Swap words in a 32-bit integer
  452. int    I;
  453. addr    A;
  454. int    T;
  455. begin
  456. A:=addr I;
  457. T:=A(0); A(0):= A(2); A(2):= T;
  458. T:=A(1); A(1):= A(3); A(3):= T;
  459. return I;
  460. end;    \SWAPWD
  461.  
  462. \----------------------------------------------------------------------
  463.  
  464. proc    CK08(VAL);    \Check for overflow of an 8-bit value
  465. int    VAL;
  466. begin
  467. if VAL>127 ! VAL<-128 then ERROR("OVERFLOW");
  468. end;    \CK08
  469.  
  470.  
  471.  
  472. proc    CK08U(VAL);    \Check for overflow of a (possibly unsigned) 8-bit value
  473. int    VAL;
  474. begin
  475. if VAL>255 ! VAL<-128 then ERROR("OVERFLOW");
  476. end;    \CK08U
  477.  
  478.  
  479.  
  480. proc    CK16(VAL);    \Check for overflow of a 16-bit value
  481. int    VAL;
  482. begin
  483. if INTSIZE=4 then
  484.     if VAL>32767 ! VAL<-32768 then ERROR("OVERFLOW");
  485. end;    \CK16
  486.  
  487.  
  488.  
  489. proc    CK16U(VAL);    \Check for overflow of a (possibly unsigned) 16-bit value
  490. int    VAL;
  491. begin
  492. if INTSIZE=4 then
  493.     if VAL>=$10000 ! VAL<-32768 then ERROR("OVERFLOW");
  494. end;    \CK16
  495.  
  496. \----------------------------------------------------------------------
  497.  
  498. func    LOOKUP(CLASS);    \Lookup current identifier and return its index
  499. \Other inputs: IDENT, HASH;
  500. \Outputs: INDEX OF IDENTIFIER. RETURNS -1 IF NOT FOUND.
  501. int    CLASS;        \Class of symbol (LAB, MN, RES)
  502. int    I, K, INX;
  503. begin
  504. INX:= HASHTBL(HASH);
  505. loop    begin
  506.     if INX= -1 then quit;                \Not found
  507.     I:= 0; K:= INX;
  508.     while IDENT(I)=SYMTBL(K) & I<SIGCHAR do
  509.         [I:= I+1; K:= K+SYMSIZE];
  510.     if I=SIGCHAR & SYMCLASS(INX)=CLASS then quit;    \Found
  511.     INX:= SYMNEXT(INX);        \Follow the linkage pointers
  512.     end;
  513. return INX;
  514. end;    \LOOKUP
  515.  
  516.  
  517.  
  518. proc    INSERT(CLASS, VAL, TYPE);
  519. \**** ???? reverse insertion order for maximum efficiency ????
  520. \Insert the current identifier into the symbol table
  521. \Other inputs: IDENT, HASH;
  522. int    CLASS, VAL, TYPE;
  523. int    I, INX, K, SPASS;
  524. begin
  525. INX:= LOOKUP(CLASS);
  526. if INX # -1 then
  527.     begin
  528.     SPASS:= PASS; PASS:= 3;        \Kludge to report error on pass 1
  529.     ERROR("LABEL ALREADY USED");
  530.     PASS:= SPASS;
  531.     XREFON:= false;        \(XREF can't handle multiple labels)
  532.     end;
  533. if SYMNUM>=SYMSIZE then
  534.     begin
  535.     SPASS:= PASS; PASS:= 3;    \Kludge to report error on pass 1
  536.     ERROR("SYMBOL TABLE OVERFLOW");
  537.     PASS:= SPASS;
  538.     SYMNUM:= SYMSIZE-1;
  539.     end;
  540. K:= SYMNUM;
  541. for I:= 0,SIGCHAR-1 do
  542.     [SYMTBL(K):= IDENT(I); K:= K+SYMSIZE];
  543.  
  544. SYMCLASS(SYMNUM):= CLASS;
  545. SYMVAL(SYMNUM):= VAL;
  546. SYMTYPE(SYMNUM):= TYPE;
  547.  
  548. SYMNEXT(SYMNUM):= HASHTBL(HASH);    \Link back
  549. HASHTBL(HASH):= SYMNUM;
  550.  
  551. SYMNUM:= SYMNUM+1;
  552. end;    \INSERT
  553.  
  554.  
  555.  
  556. proc    DOXREF(I, FLAG);  \Record reference to symbol "I"
  557. int    I, FLAG;    \Flag to indicate a label definition
  558. begin
  559. if PASS = 2 then
  560.     begin
  561.     if XREFNUM >= XREFSIZE then
  562.         begin
  563.         ERROR("CROSS-REFERENCE OVERFLOW");
  564.         XREFON:=false;
  565.         end;
  566.     if XREFON then
  567.         begin
  568.         XREFPC(XREFNUM):= PC;
  569.         XREFNEXT(XREFNUM):= SYMXREF(I);    \Link in reference
  570.         SYMXREF(I):= XREFNUM;
  571.         if FLAG then SYMXREF(I):= -XREFNUM;
  572.         XREFNUM:= XREFNUM +1;
  573.         end;
  574.     end;
  575. end;    \DOXREF
  576.  
  577. \========================== INPUT ROUTINES ============================
  578.  
  579. proc    OPENIN;        \Initialize source device as a level-0 include file
  580. begin
  581. \Get the parameters that were set up by Apex
  582. INUNIT:= ADDR(INUNT);            \Get the input unit number
  583. INBUF:= PEEKI(INBUFD);            \Get the input buffer
  584. INBUFSIZE:= PEEKI(INBUFE) - INBUF;
  585. FBLK:= PEEKI(INLBLK);            \Get the first and last blocks
  586. LBLK:= PEEKI(INHBLK);
  587.  
  588. INCLLEV:= 0;                \Start at the first nesting level
  589. INBUFINX:= INBUFSIZE;            \Indicate that the buffer is empty
  590. end;    \OPENIN
  591.  
  592.  
  593.  
  594. func    CHINX;        \Get a character from the input file
  595. \(This is optimized for speed)
  596. int    CH;
  597.  
  598.  
  599.     proc    READBUF;    \Read another buffer-full from (INCLUDE) file
  600.     int    NBLK,        \Total number of blocks in INBUF
  601.         N;        \Number of blocks actually read into buffer
  602.     begin
  603.     NBLK:= INBUFSIZE >>8;
  604.     N:= if FBLK+NBLK > LBLK then LBLK -FBLK +1 else NBLK;
  605.     READ(INUNIT, FBLK, INBUF, N);
  606.     FBLK:= FBLK +NBLK;        \Point to next buffer-full
  607.     end;    \READBUF        (Use NBLK not N because of UNNEST)
  608.  
  609.  
  610.  
  611.     proc    UNNEST;        \Unnest one include file level
  612.     int    NBLK;        \Total number of blocks in INBUF
  613.     begin
  614.     INCLLEV:= INCLLEV -1;        \Unnest one level
  615.     FBLK:= INCLNEST(INCLLEV, 0);    \Restore parameters
  616.     LBLK:= INCLNEST(INCLLEV, 1);
  617.     INBUFINX:= INCLNEST(INCLLEV, 2);
  618.     INUNIT:= INCLNEST(INCLLEV, 3);
  619.     LINECTR:= INCLNEST(INCLLEV, 4);
  620.     NBLK:= INBUFSIZE >>8;        \Back up FBLK
  621.     FBLK:= FBLK -NBLK;
  622.     READBUF;
  623.     end;    \UNNEST
  624.  
  625.  
  626. begin    \CHINX
  627. if INBUFINX >= INBUFSIZE then [INBUFINX:= 0; READBUF];
  628. CH:= INBUF(INBUFINX);
  629. INBUFINX:= INBUFINX +1;
  630.  
  631. if CH = EOF then
  632.     if INCLLEV > 0 then
  633.         begin
  634.         UNNEST;            \If INCLLEV = 0 then it's a hard EOF
  635.         CH:= CHINX;
  636.         end;
  637. return CH;
  638. end;    \CHINX
  639.  
  640.  
  641.  
  642. proc    GETLINE;    \Read a line of source code into LINEBUF
  643. \Sets LINEINX to start of line (optimized for speed)
  644. int    CH, I;
  645. begin
  646. loop    begin
  647.     for I:=0,LINESIZE-1 do
  648.         begin
  649.         CH:= CHINX;
  650.         case CH of
  651.           CR:    [LINEBUF(I):= CR; quit];
  652.           EOF:    [ENDFOUND:= true; LINEBUF(I):= CR; quit]
  653.         other    LINEBUF(I):= CH;
  654.         end;
  655.  
  656.     \The line is too long (I = LINESIZE)
  657.     LINEBUF(LINESIZE-1):=CR;    \Terminate the line
  658.     repeat CH:=CHINX until CH=CR ! CH=EOF;    \Eat the rest of the line
  659.     if CH = EOF then ENDFOUND:= true;
  660.     quit;
  661.     end;
  662. LINEINX:= 0;                \Set index to start of buffer
  663. LINECTR:= LINECTR +1;
  664. end;    \GETLINE
  665.  
  666. \----------------------------------------------------------------------
  667.  
  668. proc    GETCH;        \Get a character from LINEBUF, convert to uppercase
  669. begin
  670. CHAR:= LINEBUF(LINEINX);
  671. if CHAR>=^a then
  672.     if CHAR<=^z then CHAR:=CHAR-$20;    \shift to uppercase
  673. LINEINX:= LINEINX +1;
  674. end;    \GETCH
  675.  
  676.  
  677.  
  678. proc    SKIPTAB;    \Skip tabs and spaces in LINEBUF
  679. begin
  680. while CHAR=TAB ! CHAR=SP do GETCH;
  681. end;    \SKIPTAB
  682.  
  683.  
  684.  
  685. proc    GETCHX;        \Get next character, ignoring any space characters
  686. begin
  687. repeat GETCH until CHAR#SP;
  688. end;    \GETCHX
  689.  
  690.  
  691.  
  692. proc    GETCOMMA;    \Get a comma
  693. begin
  694. if CHAR#^, then ERROR("COMMA EXPECTED");
  695. GETCHX;                    \Skip the comma
  696. end;    \GETCOMMA
  697.  
  698.  
  699.  
  700. proc    GETIDENT;    \Read in an identifier name, e.g: FROG
  701. \OUTPUTS: HASH, IDENT
  702. int    LEN;
  703. begin
  704. IDENT(0):= CHAR;
  705. HASH:= CHAR;
  706. GETCH;
  707. LEN:= 1;
  708. loop case of
  709.   CHAR>=^A & CHAR<=^Z,  CHAR>=^0 & CHAR<=^9,  CHAR=^_ :
  710.     begin
  711.     if LEN <SIGCHAR then
  712.         begin
  713.         IDENT(LEN):= CHAR;
  714.         HASH:= HASH +CHAR;
  715.         LEN:= LEN +1;
  716.         end;
  717.     GETCH;
  718.     end
  719. other quit;
  720.  
  721. for LEN:= LEN,SIGCHAR-1 do
  722.     [IDENT(LEN):= SP; HASH:= HASH +SP];
  723.  
  724. HASH:= HASH & $FF;
  725. end;    \GETIDENT
  726.  
  727.  
  728.  
  729. func    GETDEC;        \Read in a decimal string and return its value, e.g: 123
  730. \The first digit is already read in, the first non-digit character (terminator)
  731. \ will be in CHAR
  732. int    VAL;
  733. begin
  734. VAL:= CHAR -^0;
  735. GETCH;
  736. loop    begin
  737.     if CHAR<^0 ! CHAR>^9 then quit;
  738.     VAL:= VAL *10 +CHAR -^0;
  739.     GETCH;
  740.     end;
  741. return VAL;
  742. end;    \GETDEC
  743.  
  744.  
  745.  
  746. func    GETHEX;        \Return the value of a hex string, e.g: $1AC4
  747. int    VAL, I;
  748. begin
  749. GETCH;                    \Skip the "$"
  750. case of
  751.   CHAR>=^0 & CHAR<=^9: VAL:= CHAR-^0;
  752.   CHAR>=^A & CHAR<=^F: VAL:= CHAR-$37
  753. other [ERROR("HEX DIGIT EXPECTED"); return 0];
  754. loop    begin
  755.     GETCH;
  756.     case of
  757.       CHAR>=^0 & CHAR<=^9: I:= CHAR-^0;
  758.       CHAR>=^A & CHAR<=^F: I:= CHAR-$37
  759.     other quit;
  760.     if VAL>$FFFFFFF then ERROR("OVERFLOW");
  761.  
  762.     VAL:= VAL <<4 +I;
  763.     end;
  764. return VAL;
  765. end;    \GETHEX
  766.  
  767.  
  768.  
  769. func    GETSTR;        \Return the value of a string, e.g: "ABC"
  770. int    VAL, I, QUOTE;
  771. begin
  772. VAL:= 0;
  773. I:= 0;
  774. QUOTE:= CHAR;                \save the starting quote mark
  775. loop    begin
  776.     CHAR:= LINEBUF(LINEINX);    \(don't shift to upper case)
  777.     LINEINX:= LINEINX +1;
  778.     if CHAR = QUOTE then [GETCH; quit];
  779.     if CHAR=CR then [ERROR("QUOTE MISSING"); quit];
  780.     I:= I +1;
  781.     if I = INTSIZE+1 then ERROR("OVERFLOW");
  782.     VAL:= VAL <<8 + CHAR;
  783.     end;
  784. return VAL;
  785. end;    \GETSTR
  786.  
  787. \======================== EXPRESSION EVALUATOR ========================
  788.  
  789. func    EXPRESSION;    \Returns the value of an expression
  790. int    VAL;
  791.  
  792.  
  793.  
  794. func    FACTOR;        \Returns the value of a factor
  795. int    VAL, I, NEG;
  796. begin
  797. while CHAR = ^+ do GETCHX;        \Ignore unary "+"
  798. NEG:=false;
  799. while CHAR =^- do            \Unary "-"
  800.     [GETCHX; NEG:=not NEG];
  801.  
  802. if CHAR>=^A & CHAR<=^Z then        \Label name
  803.     begin
  804.     GETIDENT;
  805.     I:= LOOKUP(RES);
  806.     if I # -1 then ERROR("RESERVED NAME")
  807.     else    begin
  808.         I:= LOOKUP(LAB);
  809.         VAL:= 0;        \Set default value
  810.         if I = -1 then ERROR("UNDEFINED")
  811.         else    begin
  812.             VAL:= SYMVAL(I);
  813.             DOXREF(I,false);
  814.             end;
  815.         end;
  816.     end
  817.  
  818. else if CHAR>=^0 & CHAR<=^9 then    \Unsigned integer
  819.     VAL:= GETDEC
  820.  
  821. else case CHAR of
  822.   ^[:    begin                \Subexpression
  823.     GETCHX;
  824.     VAL:= EXPRESSION;
  825.     if CHAR#^] then ERROR("^"]^" EXPECTED");
  826.     GETCHX;
  827.     end;
  828.  
  829.   ^@:    begin
  830.     VAL:= PC;            \Program counter
  831.     GETCHX;                \Eat the "@"
  832.     end;
  833.  
  834.   ^$:    VAL:=GETHEX;            \Unsigned hex integer
  835.  
  836.  ^",^':    VAL:=GETSTR            \String constant
  837.  
  838. other    ERROR("SYNTAX");
  839.  
  840. SKIPTAB;    \Identifiers, numbers, etc. may terminate with a space or tab
  841. return if NEG then -VAL else VAL;
  842. end;    \FACTOR
  843.  
  844.  
  845.  
  846. func    TERM;        \Returns FACTOR * FACTOR, etc.
  847. int    VAL;
  848. begin
  849. VAL:= FACTOR;
  850. loop    case CHAR of
  851.       ^*:    [GETCHX; VAL:= VAL * FACTOR];
  852.       ^/:    [GETCHX; VAL:= VAL / FACTOR];
  853.       ^\:    [GETCHX; VAL:= REM(VAL / FACTOR)]    \Modulo
  854.     other    quit;
  855. return VAL;
  856. end;    \TERM
  857.  
  858.  
  859.  
  860. proc    ALGEXP;        \Returns TERM + TERM, etc.
  861. int    VAL;
  862. begin
  863. VAL:= TERM;
  864. loop    case CHAR of
  865.       ^+:    [GETCHX; VAL:= VAL + TERM];
  866.       ^-:    [GETCHX; VAL:= VAL - TERM]
  867.     other    quit;
  868. return VAL;
  869. end;    \ALGEXP
  870.  
  871.  
  872.  
  873. func    LOGEXP;        \Returns a boolean, e.g: ALGEXP < ALGEXP
  874. int    VAL;
  875. begin
  876. if CHAR=^~ then                \Unary 'NOT' operator
  877.     begin
  878.     GETCHX;
  879.     VAL:= not LOGEXP;
  880.     end
  881. else    begin
  882.     VAL:= ALGEXP;
  883.     case CHAR of
  884.      ^=:    [GETCHX; VAL:= VAL = ALGEXP];
  885.      ^#:    [GETCHX; VAL:= VAL # ALGEXP];
  886.      ^>:    begin
  887.         GETCHX; if CHAR#^= then VAL:= VAL > ALGEXP
  888.         else [GETCHX; VAL:= VAL >= ALGEXP];
  889.         end;
  890.      ^<:    begin
  891.         GETCHX; if CHAR#^= then VAL:= VAL < ALGEXP
  892.         else [GETCHX; VAL:= VAL <= ALGEXP];
  893.         end
  894.     other;
  895.     end;
  896. return VAL;
  897. end;    \LOGEXP
  898.  
  899.  
  900.  
  901. func    BOOLTERM;    \Returns LOGEXP & LOGEXP
  902. int    VAL;
  903. begin
  904. VAL:= LOGEXP;
  905. loop    begin
  906.     if CHAR=^& then
  907.         [GETCHX; VAL:= VAL & LOGEXP]
  908.     else quit;
  909.     end;
  910. return VAL;
  911. end;    \BOOLTERM
  912.  
  913.  
  914.  
  915. begin    \EXPRESSION
  916. SKIPTAB;                \Must not have a tab or space
  917. VAL:= BOOLTERM;
  918. loop    begin
  919.     if CHAR=^! then
  920.         [GETCHX; VAL:= VAL ! BOOLTERM]
  921.     else quit;
  922.     end;
  923. return VAL;
  924. end;    \EXPRESSION
  925.  
  926. \==================== EFFECTIVE ADDRESS GENERATOR =====================
  927.  
  928. proc    DOEA(OKMODE);    \Get effective address mode bits
  929. \OUTPUTS:
  930. \    EA,        Effective address bit field (mode & reg bits)
  931. \    EXTLEN,        Number of extension words beyond opcode
  932. \    EXTWD,        Array: instruction extension words
  933. \    MODEFLAG,    Bit array indicating address mode
  934.  
  935. int    OKMODE;        \Bit array of ok EA modes (see MODEFLAG definitions)
  936. int    VAL,        \Value returned by EXPRESSION
  937.     I,
  938.     SLINEINX,    \Temporary save of LINEINX and CHAR
  939.     SCHAR;
  940.  
  941.  
  942.  
  943. proc    DOAREG;        \Get address register, return register bits in EA
  944. int    I;
  945. begin
  946. GETIDENT;
  947. SKIPTAB;
  948. I:= LOOKUP(RES);
  949. EA:= SYMTYPE(I);
  950. if I= -1 ! EA<$8 ! EA>$F then
  951.     ERROR("^"A^" REGISTER EXPECTED");
  952. EA:= EA & $7;
  953. end;    \DOAREG
  954.  
  955. \----------------------------------------------------------------------
  956.  
  957. proc    EXPRCASE;    \EA starting with an expression, e.g: d(An), d(PC,Xi)
  958. int    I;
  959.  
  960.  
  961.     proc    DOINDEX;    \Parse index register, return extension word
  962.     int    I, R;
  963.     begin
  964.     GETIDENT;
  965.     SKIPTAB;
  966.     I:= LOOKUP(RES);
  967.     R:= SYMTYPE(I);
  968.     if I=-1 ! R>$0F then ERROR("REGISTER EXPECTED");
  969.     EXTWD(EXTLEN-1):= R <<12;
  970.  
  971.     if CHAR=^. then            \Size field
  972.         begin
  973.         GETCHX;
  974.         case CHAR of
  975.           ^W:    begin
  976.             GETCHX;
  977.             end;
  978.           ^L:    begin
  979.             GETCHX;
  980.             EXTWD(EXTLEN-1):= EXTWD(EXTLEN-1) ! $0800;
  981.             end
  982.         other ERROR("INDEX SIZE");
  983.         end;
  984.     \assume size = word if not specified
  985.  
  986.     CK08(VAL);
  987.     EXTWD(EXTLEN-1):= EXTWD(EXTLEN-1) ! (VAL & $FF);
  988.     end;    \DOINDEX
  989.  
  990.  
  991.  
  992.     proc    ABSLONG;    \EA = absolute long
  993.     begin
  994.     EA:= $39;
  995.     MODEFLAG:= $0100;
  996.     EXTLEN:= EXTLEN +1;
  997.     EXTWD(EXTLEN-2):= SWAPWD(VAL);    \High word
  998.     EXTWD(EXTLEN-1):= VAL;        \Low word
  999.     end;    \ABSLONG
  1000.  
  1001.  
  1002.     proc    ABSWORD;    \EA = absolute word
  1003.     begin
  1004.     EA:= $38;
  1005.     MODEFLAG:= $0080;
  1006.     CK16(VAL);
  1007.     EXTWD(EXTLEN-1):= VAL;
  1008.     end;    \ABSWORD
  1009.  
  1010.  
  1011. begin    \EXPRCASE
  1012. VAL:= EXPRESSION;
  1013. EXTLEN:= EXTLEN +1;            \Assume there is one extension word
  1014. case CHAR of
  1015.   ^(:    begin
  1016.     GETCHX;
  1017.  
  1018.     case CHAR of
  1019.      ^A,^S:    begin                    \An or SP
  1020.         DOAREG;
  1021.         if CHAR#^, then
  1022.             begin                \d(An)
  1023.             EA:= EA + $28;
  1024.             MODEFLAG:= $0020;
  1025.             CK16(VAL);
  1026.             EXTWD(EXTLEN-1):= VAL;
  1027.             end
  1028.         else    begin                \d(An,Xn)
  1029.             EA:= EA + $30;
  1030.             MODEFLAG:= $0040;
  1031.             GETCHX;        \Eat the comma
  1032.             DOINDEX;
  1033.             end;
  1034.         end;
  1035.  
  1036.       ^P:    begin
  1037.         GETCHX;
  1038.         if CHAR#^C then ERROR("^"PC^" EXPECTED");
  1039.         GETCHX;
  1040.         if CHAR#^, then                \d(PC)
  1041.             begin
  1042.             EA:= $3A;
  1043.             MODEFLAG:= $0200;
  1044.             CK16(VAL);
  1045.             EXTWD(EXTLEN-1):= VAL;
  1046.             end
  1047.         else    begin                \d(PC,Xn)
  1048.             EA:= $3B;
  1049.             MODEFLAG:= $0400;
  1050.             GETCHX;        \Eat the comma
  1051.             DOINDEX;
  1052.             end;
  1053.         end
  1054.  
  1055.     other ERROR("An OR PC EXPECTED");
  1056.  
  1057.     if CHAR#^) then ERROR("^")^" EXPECTED");
  1058.     GETCHX;
  1059.     end;
  1060.  
  1061.   ^.:    begin                \Get size field
  1062.     GETCHX;                \Skip the "."
  1063.     case CHAR of
  1064.       ^W:    begin                    \Abs.W
  1065.         GETCHX;            \Skip the "W"
  1066.         ABSWORD;
  1067.         end;
  1068.       ^L:    begin                    \Abs.L
  1069.         GETCHX;            \Skip the "L"
  1070.         ABSLONG;
  1071.         end
  1072.     other ERROR("ABS. SIZE");
  1073.     end
  1074.  
  1075. other    ABSWORD;            \Assume size = word
  1076.  
  1077. end;    \EXPRCASE
  1078.  
  1079. \----------------------------------------------------------------------
  1080.  
  1081. begin    \DOEA
  1082. SKIPTAB;        \Tabs and spaces are stripped out beyond this point
  1083. case CHAR of
  1084.   ^(:    begin                \(An) or (An)+
  1085.     GETCHX;            \Get next char, stripping out tabs and spaces
  1086.     DOAREG;
  1087.     if CHAR#^) then ERROR("^")^" EXPECTED");
  1088.     GETCHX;
  1089.     if CHAR#^+ then
  1090.         begin            \(An)
  1091.         EA:= EA + $10;
  1092.         MODEFLAG:= $0004;
  1093.         end
  1094.     else    begin            \(An)+
  1095.         GETCHX;
  1096.         EA:= EA + $18;
  1097.         MODEFLAG:= $0008;
  1098.         end;
  1099.     end;
  1100.  
  1101.   ^-:    begin                \-(An)
  1102.     if LINEBUF(LINEINX)=^( then
  1103.         begin
  1104.         GETCH; GETCHX;        \Skip the "-("
  1105.         DOAREG;
  1106.         if CHAR#^) then ERROR("^")^" EXPECTED");
  1107.         GETCHX;
  1108.         EA:= EA + $20;
  1109.         MODEFLAG:= $0010;
  1110.         end
  1111.     else EXPRCASE;
  1112.     end;
  1113.  
  1114.   ^#:    begin                \#<xxx>
  1115.     GETCHX;
  1116.     VAL:= EXPRESSION;
  1117.     EA:= $3C;
  1118.     MODEFLAG:= $0800;
  1119.  
  1120.     case OPSIZE of
  1121.       BYTE:    begin            \.B
  1122.         EXTLEN:= EXTLEN +1;
  1123.         CK08U(VAL);
  1124.         EXTWD(EXTLEN-1):= VAL & $00FF;
  1125.         end;            \(Beware of extended negative values)
  1126.       WORD:    begin            \.W
  1127.         EXTLEN:= EXTLEN +1;
  1128.         CK16U(VAL);
  1129.         EXTWD(EXTLEN-1):= VAL;
  1130.         end;
  1131.       LONG:    begin            \.L
  1132.         EXTLEN:= EXTLEN +2;
  1133.         EXTWD(EXTLEN-2):= SWAPWD(VAL);    \High word
  1134.         EXTWD(EXTLEN-1):= VAL;        \Low word
  1135.         end
  1136.     other ERROR("SIZE");        \(Should already be detected by EA mode)
  1137.     end
  1138.  
  1139. other    begin
  1140.     \Save current state in case it's not a reserved name:
  1141.     SLINEINX:= LINEINX; SCHAR:= CHAR;
  1142.     GETIDENT;
  1143.     SKIPTAB;
  1144.     I:= LOOKUP(RES);
  1145.     if I # -1 then
  1146.         begin            \Reserved name:
  1147.         MODEFLAG:= SYMVAL(I);    \ D0-D7, A0-A7, SP, USP, CCR, SR
  1148.         EA:= SYMTYPE(I);
  1149.         if OPSIZE=BYTE & EA>=$08 & EA<=$0F then ERROR("SIZE");
  1150.         end            \(Can't use bytes with address regs)
  1151.     else    begin            \EXPRESSION
  1152.         LINEINX:= SLINEINX; CHAR:= SCHAR;
  1153.         EXPRCASE;
  1154.         end;
  1155.     end;
  1156.  
  1157. if MODEFLAG & not OKMODE then ERROR("ADDRESS MODE");
  1158. end;    \DOEA    
  1159.  
  1160. \----------------------------------------------------------------------
  1161.  
  1162. proc    DOSIZE(DEFSIZE, OKSIZE);    \Get opcode size and check if legal
  1163. int    DEFSIZE,    \Default size
  1164.     OKSIZE,        \Bit array of ok sizes:
  1165.             \ $10=BAD, $08=SHORT, $04=LONG, $02=WORD, $01=BYTE
  1166.     TBL;        \Table to convert OPSIZE to corresponding bit
  1167. begin
  1168. OPSIZE:= DEFSIZE;
  1169. if CHAR=^. then
  1170.     begin
  1171.     GETCH;            \Get character immediately following the "."
  1172.     case CHAR of
  1173.       ^B:    OPSIZE:= BYTE;
  1174.       ^W:    OPSIZE:= WORD;
  1175.       ^L:    OPSIZE:= LONG;
  1176.       ^S:    OPSIZE:= SHORT
  1177.     other    OPSIZE:=BADSIZE;    \(Because we have a ".")
  1178.     GETCH;                \Skip size character
  1179.     end;
  1180.  
  1181. TBL:= [$0, $1, $2, $4, $8, $10];    \NOSIZE, BYTE, WORD, LONG, SHORT, BADSIZE
  1182.  
  1183. if TBL(OPSIZE) & not OKSIZE then ERROR("SIZE");
  1184.     \Illegal size was specified (or internal problem)
  1185. end;    \DOSIZE
  1186.  
  1187. \========================= OPCODE HANDLERS ============================
  1188.  
  1189. proc    DONOP;        \NOP
  1190. begin
  1191. DOSIZE(NOSIZE, $0);
  1192. GENINSTR;
  1193. end;    \DONOP
  1194.  
  1195.  
  1196.  
  1197. proc    DOJMP;        \JMP <EA>
  1198. begin
  1199. DOSIZE(NOSIZE, $0);
  1200. DOEA($07E4);
  1201. OPCODE:= OPCODE ! EA;
  1202. GENINSTR;
  1203. end;    \DOJMP
  1204.  
  1205.  
  1206.  
  1207. proc    DOMOV;        \MOVE._ <EA>,<EA>
  1208. int    R, M, TBL, SEA;
  1209. begin
  1210. DOSIZE(DEFOPSIZE, $7);
  1211. DOEA($3FFF);
  1212. case MODEFLAG of
  1213.  $2000:    begin                \From SR
  1214.     if OPSIZE # WORD then ERROR("SIZE");
  1215.     GETCOMMA;
  1216.     DOEA($01FD);
  1217.     OPCODE:= $40C0 ! EA;
  1218.     GENINSTR;
  1219.     end;
  1220.  $1000:    begin                \from USP
  1221.     OPSIZE:= LONG;            \Warning: Illegal size not checked for
  1222.     GETCOMMA;
  1223.     DOEA($0002);
  1224.     OPCODE:= $4E68 ! (EA&$7);
  1225.     GENINSTR;
  1226.     end
  1227. other    begin
  1228.     OPCODE:= OPCODE ! EA;
  1229.     SEA:= EA;
  1230.     GETCOMMA;
  1231.     DOEA($71FD);
  1232.  
  1233.     case MODEFLAG of
  1234.      $4000:    begin            \To CCR
  1235.         if OPSIZE # WORD then ERROR("SIZE");
  1236.         if (SEA&$38) = $08 then ERROR("ADDRESS MODE");    \An is illegal
  1237.         OPCODE:= $44C0 ! SEA;
  1238.         GENINSTR;
  1239.         end;
  1240.      $2000:    begin            \To SR
  1241.         if OPSIZE # WORD then ERROR("SIZE");
  1242.         if (SEA&$38) = $08 then ERROR("ADDRESS MODE");    \An is illegal
  1243.         OPCODE:= $46C0 ! SEA;
  1244.         GENINSTR;
  1245.         end;
  1246.      $1000:    begin            \From USP
  1247.         OPSIZE:= LONG;        \Warning: Illegal size not checked for
  1248.         if (SEA&$38) # $08 then ERROR("ADDRESS MODE");    \Must be An
  1249.         OPCODE:= $4E60 ! (SEA&$7);
  1250.         GENINSTR;
  1251.         end
  1252.     other    begin
  1253.         R:= EA & $0007;        \Get the destination register and mode bits
  1254.         M:= EA & $0038;
  1255.         EA:= R <<9 + M <<3;
  1256.         TBL:= [$0, $1000, $3000, $2000];    \NOSIZE, BYTE, WORD, LONG
  1257.         OPCODE:= OPCODE ! EA ! TBL(OPSIZE);
  1258.         GENINSTR;
  1259.         end;
  1260.     end;
  1261. end;    \DOMOV
  1262.  
  1263.  
  1264.  
  1265. proc    DOMOVA;        \MOVEA._ <EA>,An
  1266. int    R, M, TBL;
  1267. begin
  1268. DOSIZE(DEFOPSIZE, $6);            \Word or long
  1269. DOEA($0FFF);
  1270. OPCODE:= OPCODE ! EA;
  1271. GETCOMMA;
  1272. DOEA($0002);
  1273. R:= EA & $0007;            \Get the destination register and mode bits
  1274. M:= EA & $0038;
  1275. EA:= R <<9 + M <<3;
  1276. TBL:= [$0, $1000, $3000, $2000];    \NOSIZE, BYTE, WORD, LONG
  1277. OPCODE:= OPCODE ! EA ! TBL(OPSIZE);
  1278. GENINSTR;
  1279. end;    \DOMOVA
  1280.  
  1281.  
  1282.  
  1283. proc    DOMOVP;        \MOVEP._ Dn,d(An)      MOVEP._ d(An),Dn
  1284. begin
  1285. DOSIZE(DEFOPSIZE, $6);            \Word or long
  1286. DOEA($0021);
  1287. GETCOMMA;
  1288. if MODEFLAG=$0001 then
  1289.     begin                \Source is a data register
  1290.     OPCODE:= OPCODE ! EA <<9 ! OPSIZE <<6;
  1291.     DOEA($0020);
  1292.     OPCODE:= OPCODE ! (EA &$07);
  1293.     end
  1294. else    begin                \Source is memory
  1295.     OPCODE:= OPCODE ! (OPSIZE-2) <<6 ! (EA &$07);
  1296.     DOEA($0001);
  1297.     OPCODE:= OPCODE ! EA <<9;
  1298.     end;
  1299. GENINSTR;
  1300. end;    \DOMOVP
  1301.  
  1302.  
  1303.  
  1304. proc    DOMOVM;        \MOVEM._ D3/D5-D7/A3,<ea>
  1305. int    BIT, MASK;    \MOVEM._ <ea>,D3/D5-D7/A3
  1306.  
  1307.  
  1308.     func    REVERSE(N);    \Reverse the order of the bits in "N"
  1309.     int    N;
  1310.     int    I, M;
  1311.     begin
  1312.     M:=0;
  1313.     for I:=0,15 do
  1314.         if BIT(I) & N then M:=M ! BIT(15-I);
  1315.     return    M;
  1316.     end;    \REVERSE
  1317.  
  1318.  
  1319.     proc    REGLIST;        \E.G: D1/D3-D5/A2-A4/A6
  1320.     int    I, SEA;
  1321.     begin                \First reg is already in MASK
  1322.     loop    begin
  1323.         case CHAR of
  1324.           ^/:    begin
  1325.             GETCHX;
  1326.             DOEA($0003);
  1327.             MASK:= MASK ! BIT(EA);
  1328.             end;
  1329.           ^-:    begin
  1330.             GETCHX;
  1331.             SEA:= EA;
  1332.             DOEA($0003);
  1333.             if EA<=SEA then ERROR("ADDRESS MODE");
  1334.             for I:=SEA,EA do MASK:= MASK ! BIT(I);
  1335.             end
  1336.         other quit;
  1337.         end;
  1338.     end;    \REGLIST
  1339.  
  1340.  
  1341. begin    \DOMOVM
  1342. BIT:= [    $0001, $0002, $0004, $0008, $0010, $0020, $0040, $0080,
  1343.     $0100, $0200, $0400, $0800, $1000, $2000, $4000, $8000];
  1344.  
  1345. DOSIZE(DEFOPSIZE, $6);            \Word or long
  1346. if OPSIZE=LONG then OPCODE:= OPCODE ! $40;
  1347.  
  1348. EXTLEN:= 1;                \Reserve space for register mask
  1349. DOEA($07EF);
  1350. if MODEFLAG & $0003 then
  1351.     begin                \MOVEM._ D3/D5-D7/A3,<ea>
  1352.     MASK:= BIT(EA);
  1353.     REGLIST;
  1354.     GETCOMMA;
  1355.     DOEA($01F4);
  1356.     OPCODE:= OPCODE ! EA;
  1357.     if MODEFLAG=$0010 then    \If predecrement mode, reverse MASK bits
  1358.         MASK:= REVERSE(MASK);
  1359.     end
  1360. else    begin                \MOVEM._ <ea>,D3/D5-D7/A3
  1361.     OPCODE:= OPCODE ! $400 ! EA;
  1362.     GETCOMMA;
  1363.     DOEA($0003);            \Get the first register
  1364.     MASK:= BIT(EA);
  1365.     REGLIST;
  1366.     end;
  1367. EXTWD(0):= MASK;
  1368. GENINSTR;
  1369. end;    \DOMOVM
  1370.  
  1371.  
  1372.  
  1373. proc    DOCLR;        \CLR._ <EA>
  1374. begin
  1375. DOSIZE(DEFOPSIZE, $7);
  1376. DOEA($01FD);
  1377. OPCODE:= OPCODE ! EA ! (OPSIZE-1) <<6;
  1378. GENINSTR;
  1379. end;    \DOCLR
  1380.  
  1381.  
  1382.  
  1383. proc    DOEXT;        \EXT._ Dn
  1384. begin
  1385. DOSIZE(DEFOPSIZE, $6);            \Word or long
  1386. DOEA($0001);
  1387. OPCODE:= OPCODE ! EA ! OPSIZE <<6;
  1388. GENINSTR;
  1389. end;    \DOEXT
  1390.  
  1391.  
  1392.  
  1393. proc    DOSWAP;        \SWAP.W Dn
  1394. begin
  1395. DOSIZE(WORD, $2);
  1396. DOEA($0001);
  1397. OPCODE:= OPCODE ! EA;
  1398. GENINSTR;
  1399. end;    \DOSWAP
  1400.  
  1401.  
  1402.  
  1403. proc    DOADDI;        \ADDI._ #<xxx>,<EA>
  1404. begin
  1405. DOSIZE(DEFOPSIZE, $7);
  1406. DOEA($0800);
  1407. GETCOMMA;
  1408. DOEA($01FD);
  1409. OPCODE:= OPCODE ! EA ! (OPSIZE-1) <<6;
  1410. GENINSTR;
  1411. end;    \DOADDI
  1412.  
  1413.  
  1414.  
  1415. proc    DONBCD;        \NBCD <EA>
  1416. begin
  1417. DOSIZE(BYTE, $1);
  1418. DOEA($01FD);
  1419. OPCODE:= OPCODE ! EA;
  1420. GENINSTR;
  1421. end;    \DONBCD
  1422.  
  1423.  
  1424.  
  1425. proc    DOEOR;        \EOR._ Dn,<EA>
  1426. begin
  1427. DOSIZE(DEFOPSIZE, $7);
  1428. DOEA($0001);
  1429. OPCODE:= OPCODE ! EA <<9;
  1430. GETCOMMA;
  1431. DOEA($01FD);
  1432. OPCODE:= OPCODE ! EA ! (OPSIZE-1) <<6;
  1433. GENINSTR;
  1434. end;    \DOEOR
  1435.  
  1436.  
  1437.  
  1438. proc    DOEXG;        \EXG.L Rn,Rn
  1439. int    SEA;
  1440. begin
  1441. DOSIZE(LONG, $4);
  1442. DOEA($0003);
  1443. SEA:= EA;
  1444. GETCOMMA;
  1445. DOEA($0003);
  1446. \If address register was given first...
  1447. OPCODE:= OPCODE ! (if SEA >=8 then (EA&7) <<9 ! SEA else SEA <<9 ! EA);
  1448. OPCODE:= OPCODE ! (if (SEA | EA) &8 then \An & Dn\ $80 else $40);
  1449. GENINSTR;
  1450. end;    \DOEXG
  1451.  
  1452.  
  1453.  
  1454. proc    DOLEA;        \LEA.L <EA>,An
  1455. begin
  1456. DOSIZE(LONG, $4);
  1457. DOEA($07E4);
  1458. OPCODE:= OPCODE ! EA;
  1459. GETCOMMA;
  1460. DOEA($0002);
  1461. OPCODE:= OPCODE ! (EA&$7) <<9;
  1462. GENINSTR;
  1463. end;    \DOLEA
  1464.  
  1465.  
  1466.  
  1467. proc    DOLINK;        \LINK An,#<displacement>
  1468. begin
  1469. DOSIZE(NOSIZE, $0);
  1470. DOEA($0002);
  1471. OPCODE:= OPCODE ! (EA&$7);
  1472. GETCOMMA;
  1473. OPSIZE:= WORD;                \Force to size word for #<xxx>
  1474. DOEA($0800);
  1475. GENINSTR;
  1476. end;    \DOLINK
  1477.  
  1478.  
  1479.  
  1480. proc    DOSTOP;        \STOP #<xxx>
  1481. begin
  1482. DOSIZE(NOSIZE, $0);
  1483. OPSIZE:= WORD;                \Force to size word for #<xxx>
  1484. DOEA($0800);
  1485. GENINSTR;
  1486. end;    \DOSTOP
  1487.  
  1488.  
  1489.  
  1490. proc    DOTRAP;        \TRAP #<vector>
  1491. int    VAL;
  1492. begin
  1493. DOSIZE(NOSIZE, $0);
  1494. SKIPTAB;
  1495. if CHAR#^# then ERROR("SYNTAX");
  1496. GETCHX;
  1497. VAL:= EXPRESSION;
  1498. if VAL>15 ! VAL<0 then ERROR("OVERFLOW")
  1499. else OPCODE:= OPCODE ! VAL;
  1500. GENINSTR;
  1501. end;    \DOTRAP
  1502.  
  1503.  
  1504.  
  1505. proc    DOUNLK;        \UNLK An
  1506. begin
  1507. DOSIZE(NOSIZE, $0);
  1508. DOEA($0002);
  1509. OPCODE:= OPCODE ! (EA&$7);
  1510. GENINSTR;
  1511. end;    \DOUNLK
  1512.  
  1513.  
  1514.  
  1515. proc    DOADD;        \ADD._ <EA>,Dn    ADD._ Dn,<EA>
  1516. int    D;
  1517. begin
  1518. DOSIZE(DEFOPSIZE, $7);
  1519. OPCODE:= OPCODE ! (OPSIZE-1) <<6;
  1520. DOEA($0FFF);
  1521. GETCOMMA;
  1522. if MODEFLAG=$0001 then
  1523.     begin                \Source is a data register
  1524.     D:= EA;                \Save the data register number
  1525.     DOEA($01FD);            \If the destination is a data register
  1526.     if MODEFLAG=$0001 then        \ then we must use destination Dn mode
  1527.         OPCODE:= OPCODE ! EA<<9 +D
  1528.     else    OPCODE:= OPCODE ! D <<9 ! EA ! $100;
  1529.     end
  1530. else    begin                \Source is not a data register
  1531.     OPCODE:= OPCODE ! EA;
  1532.     DOEA($0001);            \Destination must be a data register
  1533.     OPCODE:= OPCODE ! EA <<9;
  1534.     end;
  1535. GENINSTR;
  1536. end;    \DOADD
  1537.  
  1538.  
  1539.  
  1540. proc    DOCMP;        \CMP._ <EA>,Dn
  1541. begin
  1542. DOSIZE(DEFOPSIZE, $7);
  1543. OPCODE:= OPCODE ! (OPSIZE-1) <<6;
  1544. DOEA($0FFF);
  1545. GETCOMMA;
  1546. OPCODE:= OPCODE ! EA;
  1547. DOEA($0001);            \Destination must be a data register
  1548. OPCODE:= OPCODE ! EA <<9;
  1549. GENINSTR;
  1550. end;    \DOCMP
  1551.  
  1552.  
  1553.  
  1554. proc    DOCMPM;        \CMPM._ (Ay)+,(Ax)+
  1555. begin
  1556. DOSIZE(DEFOPSIZE, $7);
  1557. DOEA($0008);
  1558. OPCODE:= OPCODE ! (EA&$7) ! (OPSIZE-1) <<6;
  1559. GETCOMMA;
  1560. DOEA($0008);
  1561. OPCODE:= OPCODE ! (EA&$7) <<9;
  1562. GENINSTR;
  1563. end;    \DOCMPM
  1564.  
  1565.  
  1566.  
  1567. proc    DOADDA;        \ADDA._ <ea>,An
  1568. begin
  1569. DOSIZE(DEFOPSIZE, $6);            \Word or long
  1570. OPCODE:= OPCODE ! (if OPSIZE=WORD then $0C0 else $1C0);
  1571. DOEA($0FFF);
  1572. OPCODE:= OPCODE ! EA;
  1573. GETCOMMA;
  1574. DOEA($0002);
  1575. OPCODE:= OPCODE ! (EA&$7) <<9;
  1576. GENINSTR;
  1577. end;    \DOADDA
  1578.  
  1579.  
  1580.  
  1581. proc    DOAND;        \AND._ <ea>,Dn   AND._ Dn,<ea>
  1582. int    D;
  1583. begin
  1584. DOSIZE(DEFOPSIZE, $7);
  1585. OPCODE:= OPCODE ! (OPSIZE-1) <<6;
  1586. DOEA($0FFD);
  1587. GETCOMMA;
  1588. if MODEFLAG=$0001 then
  1589.     begin                \Source is a data register
  1590.     D:= EA;                \Save the data register number
  1591.     DOEA($01FD);            \If the destination is a data register
  1592.     if MODEFLAG = $0001 then    \ then we must use destination Dn mode
  1593.         OPCODE:= OPCODE ! EA<<9 +D
  1594.     else    OPCODE:= OPCODE ! D <<9 ! EA ! $100;
  1595.     end
  1596. else    begin                \Source is not a data register
  1597.     OPCODE:= OPCODE ! EA;
  1598.     DOEA($0001);
  1599.     OPCODE:= OPCODE ! EA <<9;
  1600.     end;
  1601. GENINSTR;
  1602. end;    \DOAND
  1603.  
  1604.  
  1605.  
  1606. proc    DOANDI;        \ANDI._ #<xxx>,<ea>
  1607. begin
  1608. DOSIZE(DEFOPSIZE, $7);
  1609. DOEA($0800);                \Immediate mode
  1610. GETCOMMA;
  1611. DOEA($61FD);
  1612. OPCODE:= OPCODE ! EA;
  1613. if MODEFLAG <= $100 then
  1614.     OPCODE:= OPCODE ! (OPSIZE-1) <<6
  1615. else if MODEFLAG = $4000 then        \ANDI.B #<xxx>,CCR
  1616.     if OPSIZE#BYTE then ERROR("SIZE")
  1617. else if MODEFLAG = $2000 then        \ANDI.W #<xxx>,SR
  1618.     if OPSIZE#WORD then ERROR("SIZE");
  1619. GENINSTR;
  1620. end;    \DOANDI
  1621.  
  1622.  
  1623.  
  1624. proc    DOCHK;        \CHK.W <ea>,Dn
  1625. begin
  1626. DOSIZE(WORD, $2);
  1627. DOEA($0FFD);
  1628. OPCODE:= OPCODE ! EA;
  1629. GETCOMMA;
  1630. DOEA($0001);
  1631. OPCODE:= OPCODE ! EA <<9;
  1632. GENINSTR;
  1633. end;    \DOCHK
  1634.  
  1635.  
  1636.  
  1637. proc    DOBCHG;
  1638. \BCHG.L Dn,Dn        BCHG.B Dn,<ea>        dynamic
  1639. \BCHG.L #<data>,Dn    BCHG.B #<data>,<ea>    static
  1640. \Warning: This does not check for certain illegal sizes
  1641. begin
  1642. DOSIZE(NOSIZE, $5);            \Byte or long (is implied)
  1643. OPSIZE:= BYTE;                \Force to .B in case #<xxx>
  1644. DOEA($0801);
  1645. GETCOMMA;
  1646. if MODEFLAG=$0001 then
  1647.     OPCODE:= OPCODE ! EA <<9    \Dynamic case -- get data register
  1648. else    OPCODE:= OPCODE & $FEFF ! $0800; \Static case -- clear bit #8 & set 11
  1649. DOEA($01FD);
  1650. OPCODE:= OPCODE ! EA;
  1651. GENINSTR;
  1652. end;    \DOBCHG
  1653.  
  1654.  
  1655.  
  1656. proc    DOASL;
  1657. int    VAL;
  1658. begin
  1659. DOSIZE(DEFOPSIZE, $7);
  1660. SKIPTAB;
  1661. if CHAR=^# then            \ASL._ #<1..8>,Dn
  1662.     begin
  1663.     GETCHX;                \Skip the "#"
  1664.     VAL:= EXPRESSION;
  1665.     if VAL>8 ! VAL<1 then ERROR("OVERFLOW");
  1666.     OPCODE:= OPCODE ! (VAL&$7) <<9 ! (OPSIZE-1) <<6;
  1667.     GETCOMMA;
  1668.     DOEA($0001);            \Get Dn
  1669.     end
  1670. else    begin
  1671.     DOEA($01FD);
  1672.     if MODEFLAG=$0001 then
  1673.         begin            \ASL._ Dn,Dn
  1674.         OPCODE:= OPCODE ! EA <<9 ! (OPSIZE-1) <<6 ! $20;
  1675.         GETCOMMA;
  1676.         DOEA($0001);        \Get Dn
  1677.         end
  1678.     else    begin            \ASL.W <ea>
  1679.         if OPSIZE#WORD then ERROR("SIZE");
  1680.         OPCODE:= OPCODE ! $C0;
  1681.         end;
  1682.     end;
  1683. OPCODE:= OPCODE ! EA;
  1684. GENINSTR;
  1685. end;    \DOASL
  1686.  
  1687.  
  1688.  
  1689. proc    DOBCC;        \Bcc._ <label>
  1690. int    VAL;
  1691. begin
  1692. DOSIZE(LONG, $C);            \Long or short
  1693. SKIPTAB;
  1694. VAL:= EXPRESSION -(PC +2);        \Get relative displacement
  1695. if OPSIZE=SHORT then
  1696.     begin
  1697.     if VAL=0 ! VAL>126 ! VAL<-126 then ERROR("OVERFLOW");
  1698.     OPCODE:= OPCODE ! (VAL &$FF);
  1699.     end
  1700. else    begin                \Long
  1701.     if VAL>32764 ! VAL<-32764 then ERROR("OVERFLOW");
  1702.     EXTLEN:=1;
  1703.     EXTWD(0):= VAL;
  1704.     end;
  1705. GENINSTR;
  1706. end;    \DOBCC
  1707.  
  1708.  
  1709.  
  1710. proc    DOADDQ;        \ADDQ._ #<1..8>,<ea>
  1711. int    VAL;
  1712. begin
  1713. DOSIZE(DEFOPSIZE, $7);
  1714. OPCODE:= OPCODE ! (OPSIZE-1) <<6;
  1715. SKIPTAB;
  1716. if CHAR#^# then ERROR("SYNTAX");
  1717. GETCHX;
  1718. VAL:= EXPRESSION;
  1719. if VAL>8 ! VAL<1 then ERROR("OVERFLOW");
  1720. OPCODE:= OPCODE ! (VAL&$7) <<9;
  1721. GETCOMMA;
  1722. DOEA($01FF);
  1723. OPCODE:= OPCODE ! EA;
  1724. GENINSTR;
  1725. end;    \DOADDQ
  1726.  
  1727.  
  1728.  
  1729. proc    DOMOVQ;        \MOVEQ.L #<xxx>,Dn
  1730. int    VAL;
  1731. begin
  1732. DOSIZE(LONG, $4);
  1733. SKIPTAB;
  1734. if CHAR#^# then ERROR("SYNTAX");
  1735. GETCHX;
  1736. VAL:= EXPRESSION;
  1737. if VAL>127 ! VAL<-128 then ERROR("OVERFLOW");
  1738. OPCODE:= OPCODE ! (VAL&$FF);
  1739. GETCOMMA;
  1740. DOEA($0001);
  1741. OPCODE:= OPCODE ! EA <<9;
  1742. GENINSTR;
  1743. end;    \DOMOVQ
  1744.  
  1745.  
  1746.  
  1747.  
  1748. proc    DOABCD;        \ABCD.B Dy,Dx    ABCD.B -(Ay),-(Ax)
  1749. begin
  1750. DOSIZE(BYTE, $1);
  1751. DOEA($0011);
  1752. OPCODE:= OPCODE ! (EA&$7) ! (if MODEFLAG = $0010 then $8 else $0);
  1753. GETCOMMA;
  1754. DOEA(MODEFLAG);                \Must be the same mode
  1755. OPCODE:= OPCODE ! (EA&$7) <<9;
  1756. GENINSTR;
  1757. end;    \DOABCD
  1758.  
  1759.  
  1760.  
  1761. proc    DOADDX;        \ADDX._ Dy,Dx    ADDX._ -(Ay),-(Ax)
  1762. begin
  1763. DOSIZE(DEFOPSIZE, $7);
  1764. DOEA($0011);
  1765. OPCODE:= OPCODE ! (EA&$7) ! (if MODEFLAG = $0010 then $8 else $0);
  1766. GETCOMMA;
  1767. DOEA(MODEFLAG);                \Must be the same mode
  1768. OPCODE:= OPCODE ! (EA&$7) <<9 ! (OPSIZE-1) <<6;
  1769. GENINSTR;
  1770. end;    \DOADDX
  1771.  
  1772.  
  1773.  
  1774. proc    DODBCC;        \DBcc.W Dn,<label>
  1775. int    VAL;
  1776. begin
  1777. DOSIZE(WORD, $2);
  1778. DOEA($0001);
  1779. OPCODE:= OPCODE ! EA;
  1780. GETCOMMA;
  1781. VAL:= EXPRESSION -(PC +2);        \Get relative displacement
  1782. if VAL>32764 ! VAL<-32764 then ERROR("OVERFLOW");
  1783. EXTLEN:=1;
  1784. EXTWD(0):= VAL;
  1785. GENINSTR;
  1786. end;    \DODBCC
  1787.  
  1788.  
  1789.  
  1790. proc    DOSCC;        \Scc.B <ea>
  1791. begin
  1792. DOSIZE(BYTE, $1);
  1793. DOEA($01FD);
  1794. OPCODE:= OPCODE ! EA;
  1795. GENINSTR;
  1796. end;    \DOSCC
  1797.  
  1798. \----------------------------- PSEUDO OPS -----------------------------
  1799.  
  1800. proc    DOORG;        \ORG    EXPRESSION
  1801. begin
  1802. DOSIZE(NOSIZE, $0);
  1803. SKIPTAB;
  1804. PC:= EXPRESSION;            \Set PC to new value
  1805. LABEL:= PC;
  1806. \If there is a label then update its value to the new PC
  1807. if LABINX # -1 then
  1808.     begin
  1809.     SYMVAL(LABINX):= LABEL;
  1810.     SYMTYPE(LABINX):=$01;        \indicate changeable label (phase)
  1811.     end;
  1812. if PASS = 2 then [CHOUT(OBJDEV, ^@); HEXOUT(OBJDEV, PC)];
  1813. end;    \DOORG
  1814.  
  1815.  
  1816.  
  1817. proc    DOEQU;        \LABEL    EQU    EXPRESSION
  1818. int    I;
  1819. begin
  1820. DOSIZE(NOSIZE, $0);
  1821. SKIPTAB;
  1822. LABEL:= EXPRESSION;            \Set label to new value
  1823. if LABINX # -1 then
  1824.     begin
  1825.     SYMVAL(LABINX):= LABEL;
  1826.     SYMTYPE(LABINX):=$01;        \Indicate changable label
  1827.     end
  1828. else ERROR("LABEL");            \Must have label
  1829. end;    \DOEQU
  1830.  
  1831.  
  1832.  
  1833. proc    DONOLIST;    \NOLIST
  1834. begin
  1835. DOSIZE(NOSIZE, $0);
  1836. LISTON:=false;
  1837. end;    \DONOLIST
  1838.  
  1839.  
  1840.  
  1841. proc    DOLIST;        \LIST
  1842. begin
  1843. DOSIZE(NOSIZE, $0);
  1844. LISTON:=true;
  1845. end;    \DOLIST
  1846.  
  1847.  
  1848.  
  1849. proc    DOPAGE;        \PAGE
  1850. begin
  1851. DOSIZE(NOSIZE, $0);
  1852. if PASS=2 & LISTON then CHOUT(LISTDEV, FF);
  1853. end;    \DOPAGE
  1854.  
  1855.  
  1856.  
  1857. proc    DODC;        \DC._    EXPRESSION, EXPRESSION, ..., EXPRESSION
  1858. int    VAL;
  1859. begin
  1860. DOSIZE(DEFOPSIZE, $7);
  1861. if OPSIZE # BYTE then DOSYNC;
  1862. loop    begin
  1863.     SKIPTAB;
  1864.     VAL:= EXPRESSION;
  1865.     case OPSIZE of
  1866.       BYTE:    GEN_B(VAL);
  1867.       WORD:    GEN_W(VAL);
  1868.       LONG:    begin
  1869.         GEN_W(SWAPWD(VAL));    \High word
  1870.         GEN_W(VAL);        \Low word
  1871.         end
  1872.     other;
  1873.     if CHAR=^, then GETCHX else quit;
  1874.     end;
  1875. end;    \DODC
  1876.  
  1877.  
  1878.  
  1879. proc    DODS;        \DS._    EXPRESSION
  1880. int    VAL, TBL;
  1881. begin
  1882. DOSIZE(DEFOPSIZE, $7);
  1883. if OPSIZE # BYTE then DOSYNC;
  1884. SKIPTAB;
  1885. VAL:= EXPRESSION;
  1886. TBL:= [0, 1, 2, 4];            \Number of bytes for each size
  1887.  
  1888. if (PC&1)#0 & OPSIZE>=WORD then        \If we're out of sync and word or long
  1889.     begin                \ then leave space for a sync byte
  1890.     PC:=PC +1;
  1891.     LABEL:= PC;
  1892.     \If there is a label then update value to new PC:
  1893.     if LABINX # -1 then
  1894.         begin
  1895.         SYMVAL(LABINX):= LABEL;
  1896.         SYMTYPE(LABINX):=$01;    \Indicate changeable label (phase)
  1897.         end;
  1898.     end;
  1899.  
  1900. PC:= PC + VAL *TBL(OPSIZE);
  1901. if PASS = 2 then [CHOUT(OBJDEV, ^@); HEXOUT(OBJDEV, PC)];
  1902. end;    \DODS
  1903.  
  1904.  
  1905.  
  1906. proc    DODCB;        \DCB._    TIMES, VAL
  1907. \Define constant block. I.e. define "TIMES" many constants of value "VAL"
  1908. int    TIMES, VAL, I;
  1909. begin
  1910. DOSIZE(DEFOPSIZE, $7);
  1911. if OPSIZE # BYTE then DOSYNC;
  1912. SKIPTAB;
  1913. TIMES:= EXPRESSION;
  1914. GETCOMMA;
  1915. VAL:= EXPRESSION;
  1916. for I:=1,TIMES do
  1917.     begin
  1918.     case OPSIZE of
  1919.       BYTE:    GEN_B(VAL);
  1920.       WORD:    GEN_W(VAL);
  1921.       LONG:    begin
  1922.         GEN_W(SWAPWD(VAL));    \HIGH WORD
  1923.         GEN_W(VAL);        \LOW WORD
  1924.         end
  1925.     other;
  1926.     end;
  1927. end;    \DODCB
  1928.  
  1929.  
  1930.  
  1931. proc    DOASCII;    \ASCII    "STRING"
  1932. int    QUOTE;
  1933. \If the string contains an apostrophy, use double quotes.
  1934. \If the string contains double quotes, use single quotes.
  1935. \If a carriage return terminates the string, it is included as part of the string.
  1936. begin
  1937. DOSIZE(NOSIZE, $0);
  1938. SKIPTAB;
  1939. QUOTE:= CHAR;
  1940. if QUOTE#^" & QUOTE#^' then ERROR("QUOTE EXPECTED")
  1941. else loop begin
  1942.     CHAR:= LINEBUF(LINEINX);    \(don't shift to upper case)
  1943.     LINEINX:= LINEINX +1;
  1944.     if CHAR = QUOTE then [GETCHX; quit];    \skip it and exit
  1945.     GEN_B(CHAR);
  1946.     if CHAR = CR then quit;
  1947.     end;
  1948. end;    \DOASCII
  1949.  
  1950.  
  1951.  
  1952. proc    DOIF;        \IF    EXPRESSION
  1953. \Warning: A label on this line is already entered in symbol table regardless
  1954. \ of whether this evaluates to true or false.
  1955. begin
  1956. DOSIZE(NOSIZE, $0);
  1957. SKIPTAB;
  1958. ASMON:= EXPRESSION;
  1959. LABEL:= ASMON;                \Show value of expression in label field
  1960. end;    \DOIF
  1961.  
  1962.  
  1963.  
  1964. proc    DOELSE;        \ELSE
  1965. begin
  1966. DOSIZE(NOSIZE, $0);
  1967. ASMON:= not ASMON;
  1968. end;    \DOELSE
  1969.  
  1970.  
  1971.  
  1972. proc    DOENDIF;    \ENDIF
  1973. begin
  1974. DOSIZE(NOSIZE, $0);
  1975. ASMON:= true;
  1976. end;    \DOENDIF
  1977.  
  1978.  
  1979.  
  1980. proc    DOINCL;        \"INCLUDE" pseudo op
  1981. int    BLK;        \Array: for SCAN
  1982. addr    NAME;        \Array: holds file name
  1983.  
  1984.  
  1985.     proc    GETNAME;    \Get name & unit of include file
  1986.     int    I;
  1987.     begin
  1988.     INUNIT:= ADDR(INUNT);        \Get the default input unit number
  1989.     NAME(8):= ^6; NAME(9):= ^8; NAME(10):= ^K;    \Default extension
  1990.  
  1991.     if CHAR>=^0 & CHAR<=^9 then
  1992.         begin            \We have an explicit unit number
  1993.         INUNIT:= CHAR & $0F;
  1994.         GETCHX;            \Skip unit number
  1995.         if CHAR#^: then ERROR("^":^" EXPECTED");
  1996.         GETCHX;            \Skip the colon
  1997.         end;
  1998.     GETIDENT;            \Get the file name (must be 8 chars)
  1999.     for I:=0,7 do NAME(I):= IDENT(I);
  2000.     if CHAR=^. then
  2001.         begin            \We have an explicit extension
  2002.         GETCHX;            \Skip the "."
  2003.         GETIDENT;
  2004.         for I:=0,2 do NAME(I+8):= IDENT(I);
  2005.         end;
  2006.     end;    \GETNAME
  2007.  
  2008.  
  2009. proc    STROUT(STR,SIZE);    \Output string to TV
  2010. addr    STR;
  2011. int    SIZE;
  2012. int    I;
  2013. begin
  2014. for I:=0, SIZE-1 do
  2015.     CHOUT(TV, STR(I));
  2016. end;    \STROUT
  2017.  
  2018.  
  2019.  
  2020. begin    \DOINCL
  2021. NAME:= RESERVE(11);
  2022. BLK:= RESERVE(2 *INTSIZE);
  2023.  
  2024. if INCLLEV > 7 then
  2025.     [ERROR("INCLUDES NESTED MORE THAN 8 LEVELS"); return];
  2026.  
  2027. SKIPTAB;
  2028. INCLNEST(INCLLEV, 0):= FBLK;        \Save current file parameters
  2029. INCLNEST(INCLLEV, 1):= LBLK;
  2030. INCLNEST(INCLLEV, 2):= INBUFINX;
  2031. INCLNEST(INCLLEV, 3):= INUNIT;
  2032. LINECTR:= 0;                \Count lines from start of INCLUDE file
  2033. INCLNEST(INCLLEV, 4):= LINECTR;
  2034. INCLLEV:= INCLLEV +1;            \Nest one level deeper
  2035. INBUFINX:= INBUFSIZE;            \Indicate that new buffer is empty
  2036.  
  2037. GETNAME;                \Get the file's name
  2038. SCAN(INUNIT, BLK, NAME);        \Get its first and last blocks
  2039. FBLK:= BLK(0);
  2040. LBLK:= BLK(1);
  2041.  
  2042. \Show the name of the inculded file:
  2043. TEXT(TV,"INCLUDING: ");
  2044. INTOUT(TV,INUNIT); CHOUT(TV,^:);
  2045. STROUT(NAME,8); CHOUT(TV,^.); STROUT(NAME+8,3); CRLF(TV);
  2046. end;    \DOINCL
  2047.  
  2048.  
  2049.  
  2050. proc    DOEND;
  2051. begin
  2052. DOSIZE(NOSIZE, $0);
  2053. ENDFOUND:= true;
  2054. end;    \DOEND
  2055.  
  2056. \----------------------------------------------------------------------
  2057.  
  2058. proc    ASMLINE;    \Assemble a line of source code
  2059. int    I;
  2060. begin
  2061. EXTLEN:= 0;                \Assume no opcode extension words
  2062. GENINX:= 0;
  2063. LABEL:= PC;                \Assume not EQU, ORG
  2064. LABINX:= -1;                \Assume no label
  2065. MNTYPE:= -1;                \Indicate no mnemonic (may be a comment line)
  2066.  
  2067. GETCH;                    \Get first character (don't skip tabs)
  2068. if CHAR>=^A & CHAR<=^Z then        \We have a label
  2069.     begin
  2070.     GETIDENT;
  2071.     if PASS = 1 then
  2072.         begin
  2073.         LABINX:= SYMNUM;    \Save index in case EQU or ORG
  2074.         INSERT(LAB, PC, 0);
  2075.         end
  2076.     else    begin            \Pass 2 -- check for phase error
  2077.         LABINX:= LOOKUP(LAB);    \If the label's changed & not EQU...
  2078.         if SYMVAL(LABINX)#PC & (SYMTYPE(LABINX) & $01) =0 then
  2079.             ERROR("PHASE");
  2080.         DOXREF(LABINX,true);
  2081.         end;
  2082.     if CHAR=^: then GETCH;        \Ignore colon
  2083.     end;
  2084.  
  2085. SKIPTAB;
  2086. if CHAR>=^A & CHAR<=^Z then        \We have a mnemonic
  2087.     begin
  2088.     GETIDENT;
  2089.     I:= LOOKUP(MN);
  2090.     if I= -1 then ERROR("MNEMONIC")
  2091.     else    begin
  2092.         OPCODE:= SYMVAL(I);
  2093.         MNTYPE:= SYMTYPE(I);
  2094.         if MNTYPE>=NOP & MNTYPE<=SCC then DOSYNC;
  2095.         case MNTYPE of
  2096.          NOP:    DONOP;
  2097.          JMP:    DOJMP;
  2098.          MOVE:    DOMOV;
  2099.          MOVEA:    DOMOVA;
  2100.          MOVEP:    DOMOVP;
  2101.          MOVEM:    DOMOVM;
  2102.          CLR:    DOCLR;
  2103.          EXT:    DOEXT;
  2104.          SWP:    DOSWAP;
  2105.          ADDI:    DOADDI;
  2106.          NBCD:    DONBCD;
  2107.          EOR:    DOEOR;
  2108.          EXG:    DOEXG;
  2109.          LEA:    DOLEA;
  2110.          LINK:    DOLINK;
  2111.          STOP:    DOSTOP;
  2112.          TRAP:    DOTRAP;
  2113.          UNLK:    DOUNLK;
  2114.          ADD:    DOADD;
  2115.          CMP:    DOCMP;
  2116.          CMPM:    DOCMPM;
  2117.          ADDA:    DOADDA;
  2118.          AND:    DOAND;
  2119.          ANDI:    DOANDI;
  2120.          CHK:    DOCHK;
  2121.          BCHG:    DOBCHG;
  2122.          ASL:    DOASL;
  2123.          BCC:    DOBCC;
  2124.          ADDQ:    DOADDQ;
  2125.          MOVEQ:    DOMOVQ;
  2126.          ABCD:    DOABCD;
  2127.          ADDX:    DOADDX;
  2128.          DBCC:    DODBCC;
  2129.          SCC:    DOSCC;
  2130.  
  2131.          ORG:    DOORG;        \Pseudo-ops
  2132.          EQU:    DOEQU;
  2133.          NOLIST:DONOLIST;
  2134.          LIST:    DOLIST;
  2135.          PAGE:    DOPAGE;
  2136.          DC:    DODC;
  2137.          DS:    DODS;
  2138.          DCB:    DODCB;
  2139.          ASCII:    DOASCII;
  2140.          IF:    DOIF;
  2141.          ELSE:    DOELSE;
  2142.          ENDIF:    DOENDIF;
  2143.          INCLUDE: DOINCL;
  2144.          END:    DOEND
  2145.         other    ERROR("INTERNAL");
  2146.         end;
  2147.     end;
  2148.  
  2149. \The rest of the line must be blank (or a comment)
  2150. \(Note: "*" cannot be used as a comment delimiter because of expressions.
  2151. \ E.g:  CLR.W FROG+2    *10 hops)
  2152. SKIPTAB;
  2153. case CHAR of
  2154.   CR, ^; : []
  2155. other ERROR("SYNTAX");
  2156. end;    \ASMLINE
  2157.  
  2158. \----------------------------------------------------------------------
  2159.  
  2160. proc    INIT;        \Main initialization
  2161. int    I, TBL;
  2162.  
  2163.  
  2164.     proc    LOADSYM(TBL, CLASS);    \Load symbol table
  2165.     int    TBL, CLASS;
  2166.     int    I, SLINEBUF;
  2167.     begin
  2168.     SLINEBUF:= LINEBUF;        \Save line buffer
  2169.     I:=0;
  2170.     loop    begin
  2171.         LINEBUF:= TBL(I);    \Set up arguments for GETIDENT
  2172.         if LINEBUF = -1 then quit;
  2173.         LINEINX:= 0;
  2174.         GETCH;
  2175.         GETIDENT;
  2176.         INSERT(CLASS, TBL(I+1), TBL(I+2));
  2177.         I:=I+3;
  2178.         end;
  2179.     LINEBUF:= SLINEBUF;
  2180.     end;    \LOADSYM
  2181.  
  2182.  
  2183. begin    \INIT
  2184. loop    begin                \(Allows saving defaults with a CTRL-P)
  2185.     TEXT(TV,"CHANGE DEFAULTS (N/Y)? ");
  2186.     if (CHIN(KB)!$20)#^y then quit;
  2187.     TEXT(TV,"DEVICE NUMBERS (OBJECT, LISTING)? ");
  2188.     DEFAULT(0):= INTIN(KB); DEFAULT(1):= INTIN(KB);
  2189.     TEXT(TV,"DO CROSS REFERENCE (N/Y)? ");
  2190.     OPENI(KB);
  2191.     DEFAULT(2):= (CHIN(KB)!$20) = ^y;
  2192.     OPENI(KB);
  2193.     end;
  2194.  
  2195. OBJDEV:= DEFAULT(0); LISTDEV:= DEFAULT(1);
  2196. OPENO(OBJDEV); OPENO(LISTDEV);
  2197. XREFON:= DEFAULT(2);
  2198.  
  2199. \Initialize some other stuff:
  2200. CRLF(TV);
  2201. ERRCNT:= 0;
  2202. SYMNUM:= 0;
  2203. XREFNUM:= 1;    \Note: "0" is used to mark empty (neg nos are used for labels)
  2204. for I:= 0,255 do HASHTBL(I):= -1;            \Indicate empty
  2205. if XREFON then for I:= 0,SYMSIZE-1 do SYMXREF(I):= 0;    \Indicate empty
  2206.  
  2207. \Load reserved names into symbol table:
  2208. \    NAME          MODEFLAG    EA
  2209. TBL:= [    "D0",        $0001,    $0,
  2210.     "D1",        $0001,    $1,
  2211.     "D2",        $0001,    $2,
  2212.     "D3",        $0001,    $3,
  2213.     "D4",        $0001,    $4,
  2214.     "D5",        $0001,    $5,
  2215.     "D6",        $0001,    $6,
  2216.     "D7",        $0001,    $7,
  2217.  
  2218.     "A0",        $0002,    $8,
  2219.     "A1",        $0002,    $9,
  2220.     "A2",        $0002,    $A,
  2221.     "A3",        $0002,    $B,
  2222.     "A4",        $0002,    $C,
  2223.     "A5",        $0002,    $D,
  2224.     "A6",        $0002,    $E,
  2225.     "A7",        $0002,    $F,
  2226.  
  2227.     "SP",        $0002,    $F,
  2228.  
  2229.     \(EA must be distinguishable from registers)
  2230.     "CCR",        $4000,    $3C,
  2231.     "SR",        $2000,    $7C,
  2232.     "USP",        $1000,    $10,
  2233.  
  2234.     \These are reserved for future use:
  2235.     "SSP",        $8000,    $10,
  2236.     "PC",        $8000,    $10,
  2237.     -1];
  2238.  
  2239. LOADSYM(TBL,RES);
  2240.  
  2241. \Load mnemonics into symbol table:
  2242. \    NAME        OPCODE    TYPE
  2243. TBL:= [    "NOP",        $4E71,    NOP,
  2244.     "RESET",    $4E70,    NOP,
  2245.     "RTE",        $4E73,    NOP,
  2246.     "RTR",        $4E77,    NOP,
  2247.     "RTS",        $4E75,    NOP,
  2248.     "TRAPV",    $4E76,    NOP,
  2249.     "JMP",        $4EC0,    JMP,
  2250.     "JSR",        $4E80,    JMP,
  2251.     "PEA",        $4840,    JMP,
  2252.     "MOVE",        $0000,    MOVE,
  2253.     "MOVEA",    $0000,    MOVEA,
  2254.     "MOVEP",    $0108,    MOVEP,
  2255.     "MOVEM",    $4880,    MOVEM,
  2256.     "CLR",        $4200,    CLR,
  2257.     "NEG",        $4400,    CLR,
  2258.     "NEGX",        $4000,    CLR,
  2259.     "NOT",        $4600,    CLR,
  2260.     "TST",        $4A00,    CLR,
  2261.     "EXT",        $4880,    EXT,
  2262.     "SWAP",        $4840,    SWP,
  2263.     "ADDI",        $0600,    ADDI,
  2264.     "SUBI",        $0400,    ADDI,
  2265.     "CMPI",        $0C00,    ADDI,
  2266.     "NBCD",        $4800,    NBCD,
  2267.     "TAS",        $4AC0,    NBCD,
  2268.     "EOR",        $B100,    EOR,
  2269.     "EXG",        $C100,    EXG,
  2270.     "LEA",        $41C0,    LEA,
  2271.     "LINK",        $4E50,    LINK,
  2272.     "STOP",        $4E72,    STOP,
  2273.     "TRAP",        $4E40,    TRAP,
  2274.     "UNLK",        $4E58,    UNLK,
  2275.     "ADD",        $D000,    ADD,
  2276.     "SUB",        $9000,    ADD,
  2277.     "CMP",        $B000,    CMP,
  2278.     "CMPM",        $B108,    CMPM,
  2279.     "ADDA",        $D0C0,    ADDA,
  2280.     "CMPA",        $B0C0,    ADDA,
  2281.     "SUBA",        $90C0,    ADDA,
  2282.     "AND",        $C000,    AND,
  2283.     "OR",        $8000,    AND,
  2284.     "ANDI",        $0200,    ANDI,
  2285.     "EORI",        $0A00,    ANDI,
  2286.     "ORI",        $0000,    ANDI,
  2287.     "CHK",        $4180,    CHK,
  2288.     "DIVS",        $81C0,    CHK,
  2289.     "DIVU",        $80C0,    CHK,
  2290.     "MULS",        $C1C0,    CHK,
  2291.     "MULU",        $C0C0,    CHK,
  2292.     "BCHG",        $0140,    BCHG,    \(Bit #8 must be set & 11 clear
  2293.     "BCLR",        $0180,    BCHG,    \ for BCHG types)
  2294.     "BSET",        $01C0,    BCHG,
  2295.     "BTST",        $0100,    BCHG,
  2296.     "ASL",        $E100,    ASL,
  2297.     "ASR",        $E000,    ASL,
  2298.     "LSL",        $E108,    ASL,
  2299.     "LSR",        $E008,    ASL,
  2300.     "ROL",        $E118,    ASL,
  2301.     "ROR",        $E018,    ASL,
  2302.     "ROXL",        $E110,    ASL,
  2303.     "ROXR",        $E010,    ASL,
  2304.     "BRA",        $6000,    BCC,
  2305.     "BSR",        $6100,    BCC,
  2306.     "BHI",        $6200,    BCC,
  2307.     "BLS",        $6300,    BCC,
  2308.     "BCC",        $6400,    BCC,
  2309.     "BHS",        $6400,    BCC,
  2310.     "BCS",        $6500,    BCC,
  2311.     "BLO",        $6500,    BCC,
  2312.     "BNE",        $6600,    BCC,
  2313.     "BEQ",        $6700,    BCC,
  2314.     "BVC",        $6800,    BCC,
  2315.     "BVS",        $6900,    BCC,
  2316.     "BPL",        $6A00,    BCC,
  2317.     "BMI",        $6B00,    BCC,
  2318.     "BGE",        $6C00,    BCC,
  2319.     "BLT",        $6D00,    BCC,
  2320.     "BGT",        $6E00,    BCC,
  2321.     "BLE",        $6F00,    BCC,
  2322.     "ADDQ",        $5000,    ADDQ,
  2323.     "SUBQ",        $5100,    ADDQ,
  2324.     "MOVEQ",    $7000,    MOVEQ,
  2325.     "ABCD",        $C100,    ABCD,
  2326.     "SBCD",        $8100,    ABCD,
  2327.     "ADDX",        $D100,    ADDX,
  2328.     "SUBX",        $9100,    ADDX,
  2329.     "DBT",        $50C8,    DBCC,
  2330.     "DBF",        $51C8,    DBCC,
  2331.     "DBHI",        $52C8,    DBCC,
  2332.     "DBLS",        $53C8,    DBCC,
  2333.     "DBCC",        $54C8,    DBCC,
  2334.     "DBHS",        $54C8,    DBCC,
  2335.     "DBCS",        $55C8,    DBCC,
  2336.     "DBLO",        $55C8,    DBCC,
  2337.     "DBNE",        $56C8,    DBCC,
  2338.     "DBEQ",        $57C8,    DBCC,
  2339.     "DBVC",        $58C8,    DBCC,
  2340.     "DBVS",        $59C8,    DBCC,
  2341.     "DBPL",        $5AC8,    DBCC,
  2342.     "DBMI",        $5BC8,    DBCC,
  2343.     "DBGE",        $5CC8,    DBCC,
  2344.     "DBLT",        $5DC8,    DBCC,
  2345.     "DBGT",        $5EC8,    DBCC,
  2346.     "DBLE",        $5FC8,    DBCC,
  2347.     "ST",        $50C0,    SCC,
  2348.     "SF",        $51C0,    SCC,
  2349.     "SHI",        $52C0,    SCC,
  2350.     "SLS",        $53C0,    SCC,
  2351.     "SCC",        $54C0,    SCC,
  2352.     "SHS",        $54C0,    SCC,
  2353.     "SCS",        $55C0,    SCC,
  2354.     "SLO",        $55C0,    SCC,
  2355.     "SNE",        $56C0,    SCC,
  2356.     "SEQ",        $57C0,    SCC,
  2357.     "SVC",        $58C0,    SCC,
  2358.     "SVS",        $59C0,    SCC,
  2359.     "SPL",        $5AC0,    SCC,
  2360.     "SMI",        $5BC0,    SCC,
  2361.     "SGE",        $5CC0,    SCC,
  2362.     "SLT",        $5DC0,    SCC,
  2363.     "SGT",        $5EC0,    SCC,
  2364.     "SLE",        $5FC0,    SCC,
  2365.  
  2366.     \PSEUDO-OPS:
  2367.     "ORG",        $0000,    ORG,
  2368.     "EQU",        $0000,    EQU,
  2369.     "NOLIST",    $0000,    NOLIST,
  2370.     "LIST",        $0000,    LIST,
  2371.     "PAGE",        $0000,    PAGE,
  2372.     "DC",        $0000,    DC,
  2373.     "DS",        $0000,    DS,
  2374.     "DCB",        $0000,    DCB,
  2375.     "ASCII",    $0000,    ASCII,
  2376.     "IF",        $0000,    IF,
  2377.     "ELSE",        $0000,    ELSE,
  2378.     "ENDIF",    $0000,    ENDIF,
  2379.     "INCLUDE",    $0000,    INCLUDE,
  2380.     "END",        $0000,    END,
  2381.     -1];
  2382.  
  2383. LOADSYM(TBL,MN);
  2384. end;    \INIT
  2385.  
  2386. \----------------------------------------------------------------------
  2387.  
  2388. begin    \MAIN
  2389. LINEBUF:= RESERVE(LINESIZE);
  2390. IDENT:= RESERVE(SIGCHAR);
  2391.  
  2392. SYMTBL:= RESERVE(SIGCHAR *SYMSIZE);
  2393. SYMCLASS:= RESERVE(SYMSIZE);
  2394. \(SYMCLASS must follow SYMTBL for QUICKSORT to work -- insures unique entries)
  2395. SYMVAL:= RESERVE(SYMSIZE *INTSIZE);
  2396. SYMTYPE:= RESERVE(SYMSIZE);
  2397. SYMNEXT:= RESERVE(SYMSIZE *INTSIZE);
  2398.  
  2399. HASHTBL:= RESERVE(256 *INTSIZE);    \Hash table
  2400. EXTWD:= RESERVE(4 *INTSIZE);
  2401. GENBUF:= RESERVE(GENSIZE);
  2402.  
  2403. SYMINX:= SYMNEXT;            \Use same array space
  2404. SYMXREF:= RESERVE(SYMSIZE *INTSIZE);
  2405. XREFPC:= RESERVE(XREFSIZE *INTSIZE);
  2406. XREFNEXT:= RESERVE(XREFSIZE *INTSIZE);
  2407.  
  2408. INCLNEST:= RESERVE(8 *INTSIZE);
  2409. for II:= 0,7 do INCLNEST(II):= RESERVE(5 *INTSIZE);
  2410.  
  2411. DEFAULT:= [3, 7, false];        \Defaults (OBJ, LIST, XREF)
  2412. ADDR:= 0;
  2413.  
  2414. TEXT(TV,"-- ASM68K, V1.0x10 --
  2415.  
  2416. ");
  2417. INIT;
  2418.  
  2419. for PASS:=1,2 do
  2420.     begin
  2421.     TEXT(TV,"PASS "); INTOUT(TV,PASS); TEXT(TV,"..."); CRLF(TV);
  2422.     OPENIN;                \Initialize input
  2423.     PC:= 0;                \Set default PC
  2424.     ENDFOUND:= false;
  2425.     LISTON:= true;            \Default is "LIST"
  2426.     ASMON:= true;            \Turn on assembler (IF)
  2427.     LINECTR:= 0;
  2428.     repeat    begin
  2429.         ERRTOLD:= false;    \No errors reported yet for this line
  2430.         GETLINE;
  2431.         if ENDFOUND then    \Assume "END" if EOF was found
  2432.             ERROR("^"END^" EXPECTED");
  2433.         if ASMON then ASMLINE
  2434.         else    begin        \Conditional assy is off -- look
  2435.             GETCH;        \ for an ENDIF or ELSE
  2436.             if CHAR>=^A & CHAR<=^Z then GETIDENT;    \Skip label
  2437.             SKIPTAB;
  2438.             if CHAR>=^A & CHAR<=^Z then
  2439.                 begin
  2440.                 GETIDENT;    \Get mnemonic
  2441.                 II:= LOOKUP(MN);
  2442.                 if II # -1 then
  2443.                     begin
  2444.                     MNTYPE:= SYMTYPE(II);
  2445.                     case SYMTYPE(II) of
  2446.                      ELSE:    DOELSE;
  2447.                      ENDIF:    DOENDIF
  2448.                     other;
  2449.                     end;
  2450.                 end;
  2451.             end;
  2452.         if PASS=2 & LISTON & LISTDEV#NULLDEV then
  2453.             LISTOUT(LISTDEV);
  2454.         end;
  2455.     until ENDFOUND;
  2456.     end;
  2457.  
  2458. if XREFON then XREFOUT;
  2459.  
  2460. CRLF(LISTDEV);
  2461. TEXT(LISTDEV,"ERRORS DETECTED: "); INTOUT(LISTDEV,ERRCNT); CRLF(LISTDEV);
  2462. if LISTDEV#TV then
  2463.     begin
  2464.     CRLF(TV);
  2465.     TEXT(TV,"ERRORS DETECTED: "); INTOUT(TV,ERRCNT); CRLF(TV);
  2466.     end;
  2467. if ERRCNT>0 then CHOUT(TV,BEL);
  2468. CLOSE(LISTDEV);
  2469. CLOSE(OBJDEV);
  2470. end;    \MAIN
  2471. TECTED: "); INTOUT(TV,E